Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / ik0cmd.asm < prev next >

Wrap

Assembly Source File | 1992-09-29 | 165.6 KB | 2,095 lines

*COPY IK0CMD 03000000 CHECKVER IK0CMD,4.2 @SC90072 03000500 TITLE 'USNTRF Routine - execute main loop' 03001000 * Execute Kermit commands (beginning with default TAKE files) 03002000 * Entry: environment already set up 03003000 * Exit: R15=0 03004000 * ERRNUM set appropriately 03005000 USNTRF ENTER 03006000 LA 0,KRMPROT @SC86295 03007000 LA 1,USNCMD Full list of commands @SC87117 03008000 BAL 14,LOOPS Set up loop return @SC86295 03009000 LA 2,USRTAKE 03010000 LA 1,LUSRT Length of name @SC86295 03011000 BAL 9,LUPTIN Test user KERMINI @SC86295 03012000 NOP 0 Not found, skip it @SC86295 03013000 LA 2,SYSTAKE @SC86135 03014000 LA 1,LSYST Length of name @SC86295 03015000 BAL 9,LUPTIN Test system KERMINI @SC86295 03016000 NOP 0 Not found, skip it @SC86295 03017000 MVI ERRNUM,ERRNFT No transfers yet @SC86295 03018000 KCALL SUPFNC,6,E=LOOP @SC86295 03019000 OI KFLG,CMDL+SIGN Got command line, suppress banner@SC86295 03020000 B LOOP @SC86295 03021000 * 03022000 KRMININC WTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)' 03023000 WTEXT 'Enter ? for a list of valid commands' 03024000 STRTMSGS , Any system-specific messages... @SC87338 03025000 OI KFLG,SIGN Banner done @SC86295 03026000 KRMPROB PTEXT BLANK,1 And leave a blank line 03027000 B LUPWRT Not an error @SC86295 03028000 * 03029000 KRMPROT TM KFLG,CMDL @SC86295 03030000 BZ KRMPROCL Go if Not cmd line 03031000 NI KFLG,255-CMDL Turn off command line @SC86295 03032000 OI KFLG,CMDC Command from cmd line @SC86295 03033000 L 1,CBUF address of cmd 03034000 L 0,CLEN Length @SC86171 03035000 B LUPPRS Go process it @SC86295 03036000 * 03037000 KRMPROCL TM KFLG,CMDC @SC86295 03038000 BZ KRMPROR Go if not cmd line 03039000 KCALL SUPFNC,7,E=(KRMXITQ,Z) Go if nothing stacked @SC86295 03040000 KRMPROR TM KFLG,SIGN Already printed banner? @SC86295 03041000 BO KRMPROX Yes, or suppressed @SC86295 03042000 KCALL SUPFNC,7,E=(KRMININC,Z) Go if nothing stacked @SC86295 03043000 KRMPROX LA 3,CMD @SC86295 03044000 LA 4,KPRPT Current prompt @SC87268 03045000 SR 0,0 @SC87268 03046000 IC 0,KPRPL Prompt length @SC87268 03047000 RTEXT (3),PROMPT=((4),(0)) @SC87268 03048000 LA 1,CMD Ptr to command @SC86171 03049000 B LUPPRS Go process it @SC86295 03050000 * 03051000 USNCMD KW 'EXIT',KRMXIT,MIN=2 03052000 KW 'QUIT',KRMXIT 03053000 AIF ('&KSYS' NE 'TSO').TS0Z @SC88035 03053200 KW 'END',KRMXIT,MIN=3 Synonym for QUIT @SC88035 03053400 .TS0Z ANOP 03053600 USNCMDX KW 'BYE',KRMBYE,MIN=3 @SC86155 03054000 KW 'DIRECTORY',KRMDIR,MIN=3 @SC86295 03055000 KW 'ECHO',KRMECO,MIN=2 03056000 KW 'FINISH',KRMFIN,MIN=3 @SC86155 03057000 KW 'GET',KRMGET @SC86155 03058000 KW 'HELP',KRMHLP 03059000 KW 'LOCAL',LUPTOK,MIN=3 @SC86295 03060000 KW 'RECEIVE',KRMREC,MIN=3 03061000 KW 'REMOTE',KRMREM,MIN=3 @SC86155 03062000 KW 'SEND',KRMSND,MIN=3 03063000 KW 'SERVER',KRMSRV,MIN=3 03064000 KW 'XECHO',KRMXPE,MIN=2 @SC86204 03065000 KW 'XTYPE',KRMNPS,MIN=2 @SC86204 03066000 SRVKCMD KW '&KSYS.',LUPHST,MIN=2 Valid in Server mode ... @SC86295 03067000 AIF ('&KSYS' NE 'CMS').CM0Z @SC86355 03068000 KW 'CP',LUPCP,MIN=2 @SC86295 03069000 .CM0Z KW 'CWD',LUPCWD,MIN=2 @SC86295 03070000 KW 'GIVE',LUPGIV,MIN=2 @SC87117 03071000 KW 'HOST',LUPHST,MIN=2 @SC87253 03072000 KW 'KERMIT',LUPKRM @SC90059 03073000 KW 'SET',LUPSET,MIN=3 @SC86295 03074000 KW 'SHOW',LUPSHO,MIN=2 @SC86295 03075000 KW 'SPACE',LUPSPA,MIN=2 @SC86295 03076000 KW 'STATUS',LUPSTA,MIN=2 @SC86295 03077000 KW 'TAKE',LUPTAK,MIN=2 @SC86295 03078000 KW 'TDUMP',LUPDMP,MIN=2 @SC86295 03079000 KW 'TYPE',LUPHSTI,MIN=TYPMIN @SC88018 03080000 KW 03081000 * 03082000 KRMECO L 3,ADR Pick rest of line 03083000 ICM 4,B'1111',LEN Remaining data length 03084000 BNP KRMPROB Go if nothing left in cmd 03085000 B LUPWRT Else, print the rest @SC86295 03086000 * @SC86155 03087000 KRMREM KCALL GENCMD,0,E=LUPERK Send remote command @SC86295 03088000 B KRMXFZ @SC87300 03089000 * @SC86155 03090000 KRMBYE BAL 14,LUPCNF Check for illegal extras @SC86295 03091000 KCALL GENCMD,AL Send Logout command @SC86155 03092000 B KRMXFZ @SC87300 03093000 * 03094000 KRMFIN BAL 14,LUPCNF Check for illegal extras @SC86295 03095000 KCALL GENCMD,AF Send Finish command @SC86155 03096000 B KRMXFZ @SC87300 03097000 * 03098000 KRMGET PTEXT 'Foreign filespec - ',AREG=1,LREG=0 @SC88035 03099000 BAL 2,USNASKA Prompt if user omitted args @SC88035 03099300 LA 0,FFGET @SC88049 03099600 KCALL FSPEC,JFSPEC Get foreign filespec @SC86295 03100000 BAL 14,LUPCKFN @SC86295 03101000 PTEXT '&KSYS filespec - ',AREG=1,LREG=0 @SC88035 03101300 BAL 2,USNASKT Prompt if necessary @SC88035 03101600 LA 0,FFGET+FFRCF @SC88049 03102000 KCALL FSPEC,FILNAM Get native filespec, if any @SC86295 03103000 BAL 14,LUPCKFN @SC86295 03104000 BAL 14,LUPCNF Check for illegal extras @SC86295 03105000 TM FL3,APPN Going to append anyway? @SC90033 03105100 BO USNGCK Yes, ignore collisions @SC90033 03105200 TM FL1,REN+ROVR Warning ON and name given? @SC88089 03105300 BNO USNGCK No, don't check for collision yet @SC88089 03105600 LA 0,FFNEW+FFGET @SC87012 03106000 KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions @SC87012 03107000 USNGCK DS 0H @SC88089 03107500 BAL 8,IPKSET Set state table, exchange parms @SC86295 03108000 * Init packet Rpack interpret input tables @SC86155 03109000 DC AL1(AY),AL3(0) ACK'ed @SC86155 03110000 DC XL1'FF',AL3(KRMGETAB) Stop @SC88074 03110500 DC AL1(00),AL3(KRMGETAB) Error @SC86155 03111000 BAL 9,PAKFIL Copy file specification to buffer @HF86223 03112000 BAL 9,ENCODEN Encode file-spec @SC86295 03113000 MVI STYPE,AR Packet type = receive initiate @SC86155 03114000 KCALL SPACK,E=KRMGETAB Send name @SC86155 03115000 KCALL RECEIV @SC86155 03116000 B KRMXFZ @SC86239 03117000 * 03118000 KRMGETAB KCALL INTINI,0 @SC86155 03119000 B KRMXFZ @SC87300 03120000 * 03121000 KRMREC LA 0,FFRCF @SC86295 03122000 KCALL FSPEC,FILNAM Get filespec @SC86295 03123000 BAL 14,LUPCKFN @SC86295 03124000 BAL 14,LUPCNF Check for illegal extras @SC86295 03125000 TM FL3,APPN Going to append anyway? @SC90033 03125100 BO USNRCK Yes, ignore collisions @SC90033 03125200 TM FL1,REN+ROVR Warning ON and name given? @SC88089 03125300 BNO USNRCK No, don't check for collision yet @SC88089 03125600 LA 0,FFNEW+FFGET @SC87012 03126000 KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions @SC87012 03127000 TM FL4,NMCHNG @SC90061 03127080 BZ USNRCK @SC90061 03127160 PTEXT 'File already exists, RECEIVE discarded' @SC90061 03127240 CLI CLSNFL,C'D' @SC90061 03127320 BE LUPWRTE @SC90061 03127400 USNRCK DS 0H @SC88089 03127500 KCALL INTINI,3,E=KRMXFZ Initialize for receive @SC87300 03128000 MVI RTYPE,0 No packet read yet @SC88074 03128500 KCALL RECEIV 03129000 B KRMXFZ @SC86239 03130000 * 03131000 KRMNPS OI FL4,NPS @SC86165 03132000 MVI TCTLQ,0 Turn off control quoting @SC86165 03133000 * 03134000 KRMSND PTEXT '&KSYS filespec - ',AREG=1,LREG=0 @SC88035 03135000 BAL 2,USNASKA Prompt if necessary @SC88035 03135300 SR 6,6 No extra files yet @SC88306 03135370 L 7,MSNDBUF Start of buffer @SC88306 03135440 USNSND1 DS 0H @SC88306 03135510 LA 0,FFSND @SC88035 03135600 KCALL FSPEC,IFILE Get filespec @SC86295 03136000 BAL 14,LUPCKFN @SC86295 03137000 PTEXT 'Foreign filespec - ',AREG=1,LREG=0 @SC88035 03137300 BAL 2,USNASKT Prompt if user omitted args @SC88035 03137600 LA 0,FFSND+FFRCF @SC86295 03138000 KCALL FSPEC,JFSPEC Get filespec @SC86295 03139000 BAL 14,LUPCKFN @SC86295 03140000 CLI BRK,C',' Multi-file option? @SC88306 03140070 BNE USNSND2 @SC88306 03140140 A 6,F1 Count files to send @SC88306 03140210 PTEXT 'Too many SEND files' @SC88306 03140280 CH 6,=Y(MSNDMAX) Too many? @SC88306 03140350 BH LUPINV Too bad @SC88306 03140420 MVC 0(LFSTF,7),IFILE Save filespecs + options @SC89218 03140490 LA 7,LFSTF(,7) Advance ptr into buffer @SC89218 03140630 PTEXT '&KSYS filespec - ',AREG=1,LREG=0 @SC88306 03140700 BAL 2,USNASKT Prompt if necessary @SC88306 03140770 B USNSND1 Go for another name @SC88306 03140840 USNSND2 ST 7,MSNDPTR Save buffer scan ptr @SC88306 03140910 BAL 14,LUPCNF Check for illegal extras @SC86295 03141000 KRMSNDBG KCALL SEND 03142000 KRMXFZ SR 3,3 @SC86355 03143000 ICM 3,1,ERRNUM Ok? @SC86355 03144000 BZ LOOP Yes, get next command @SC86355 03145000 SLL 3,2 No, convert error number @SC86355 03146000 A 3,=A(ERRTAB) Ptr into message table @SC89215 03147000 SR 4,4 @SC86355 03148000 IC 4,0(3) Length @SC86355 03149000 ICM 3,7,1(3) Message ptr @SC86355 03150000 B LUPWRTE Display it and go on @SC86355 03151000 * 03151070 USNASKA NI KFLG,255-PRMP Assume no prompting @SC88035 03151140 FTOKN N=USNASK Check for some text waiting @SC88035 03151210 BR 2 Ok, use it @SC88035 03151280 USNASKT TM KFLG,PRMP Is prompting required? @SC88035 03151350 BZR 2 No, ok @SC88035 03151420 USNASK OI KFLG,PRMP Must prompt for both filespecs @SC88035 03151490 LA 3,CMD Use input buffer @SC88035 03151560 ST 3,ADR @SC88035 03151630 RTEXT (3),PROMPT=((1),(0)) Ask for filespec @SC88035 03151700 ST 0,LEN Save string length @SC88035 03151770 BR 2 @SC88035 03151840 * 03152000 KRMXPE L 5,ADR Pointer to rest of line @HF86150 03153000 ICM 4,15,LEN Remaining data length @HF86150 03154000 BNP KRMXPEH Go if nothing specified @HF86150 03155000 L 3,RBUF @HF86150 03156000 MVC 0(256,3),0(5) Copy to disk read buffer @HF86150 03157000 AR 4,3 Get end @HF86150 03158000 STM 3,4,TXTPTR Point to text to copy @HF86150 03159000 OI FL4,SFM+NPS Data source: text string @SC86165 03160000 MVI TCTLQ,AUP Turn on control quoting @SC86165 03161000 MVC MSNDPTR,MSNDBUF No extra files @SC88306 03161500 B KRMSNDBG @SC86165 03162000 * 03163000 KRMXPEH PTEXT 'Text string with ^X for cntl-X' @SC86165 03164000 B LUPWRT @SC86295 03165000 * 03166000 KRMSRV BAL 14,LUPCNF Check for illegal extras @SC86295 03167000 KCALL SERVER Call SERVER routine @SC86295 03168000 B KRMXFZ Return to normal mode @SC86355 03169000 * 03170000 KRMDIR LA 0,FFUTL+FFWLD @SC86295 03171000 KCALL FSPEC,FILNAM Get pattern filespec @SC86295 03172000 BAL 14,LUPCKFN Make sure ok @SC86295 03173000 LA 0,13 @SC86295 03174000 KCALL DISKIO,FILNAM Do a DIR on it @SC86295 03175000 B LOOP @SC86295 03176000 * 03177000 KRMHLP KCALL KHELP Issue help request @SC86355 03178000 B LOOP @SC86355 03179000 * 03180000 KRMXIT FTOKN N=KRMXITQ,H=LUPCRH Check for illegal extras @SC86295 03181000 B LUPBAD Not just QUIT, maybe system Q @SC86295 03182000 * 03183000 KRMXITQ NXTFSET ,END Flush pending file list @SC86355 03184000 L 2,TAKLEVK @SC86295 03185000 KRMXITL BCTR 2,0 @SC86295 03186000 LTR 3,2 Any pending TAKE files? @SC86295 03187000 BM RTRN0 No @SC86295 03188000 SLA 3,2 @SC86295 03189000 CLOSF TAKTABK(3) Close the open file @SC86295 03190000 B KRMXITL Keep checking @SC86295 03191000 LOCALS , @SC86295 03192000 * See SERVER for mapping @SC86295 03193000 DS A Return adr if no more TAKE stuff @SC86295 03194000 DS A Adr of command table @SC86295 03195000 TAKLEVK DS F Take file level @SC86295 03196000 TAKTABK DS (TAKMAX)F Tickets for I/O @SC86295 03197000 KFLG DS X Local flags in main program @SC86295 03198000 PRMP EQU X'10' Prompting for filespecs @SC88035 03198500 SIGN EQU X'04' Already printed Kermit banner @SC86295 03199000 CMDC EQU X'02' Command gotten from cmd 03200000 CMDL EQU X'01' Data on cmd line 03201000 USNTRF EXIT 03202000 TITLE 'SET Routine - perform SET command options' 03203000 * Set/change values in STORAG. 03204000 * Entry: SCANPTR string has option 03205000 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name 03206000 * ERRNUM unchanged 03207000 SET ENTER 03208000 MVI SETXI,X'97' XI instruction @SC86273 03209000 NTOKN N=RTRN2 @SC86171 03210000 NI FL3,255-PXCH Make sure server renegotiates @SC86295 03211000 L 3,=A(SETCMDS) @SC90040 03211300 USING SETCMDS,3 Address CSECT throughout @SC90040 03211600 SCAN SETCMDKW,RTRN1 @SC86295 03212000 B RTRN2 @SC86295 03213000 * 03214000 SETCMDS CSECT @SC90040 03214500 SETOOKW KW 'OFF',SETOFF,MIN=2 @SC87166 03215000 KW 'ON',SETON,MIN=2 @SC87166 03216000 KW , @SC87166 03217000 * 03218000 SETCMDOO KW 'OFF',SETOFFS,MIN=2 @SC87166 03221000 SETONKW KW 'ON',SETONS,MIN=2 @SC87166 03222000 KW , @SC86171 03223000 SET CSECT @SC90040 03223500 * 03224000 SETOFF EX 0,0(9) Yes, first turn flag on... @SC87166 03225000 EX 0,SETXI Then off @SC86273 03226000 B RTRN0 @SC87166 03227000 * 03228000 SETON EX 0,0(9) Turn flag on @SC87166 03229000 B RTRN0 @SC87166 03230000 * 03231000 SETOFFS B 4(9) @SC87166 03232000 * 03233000 SETONS BR 9 Go to ON handler @SC87166 03234000 * 03235000 SETCMDS CSECT @SC90040 03235500 SETTRKW KW 'TTY',SETT @SC87166 03236000 KW 'SERIES1',SETT @SC87166 03237000 KW 'GRAPHICS',SETT @SC87166 03238000 KW 'FULLSCREEN',SETTF @SC89096 03239000 KW 'VTAMTTY',SETT @SC88323 03239500 KW , @SC87166 03240000 SET CSECT @SC90040 03240500 * 03241000 SETT MVC TRMTP,0(6) @SC87166 03242000 B RTRN0 @SC87166 03243000 * 03243200 SETTF MVI TRMTP,C'V' @SC89096 03243400 B RTRN0 @SC89096 03243600 * 03244000 SETCMDS CSECT @SC90040 03244500 SETSWT KW 'CONTINUE',SETOFF @SC86171 03245000 KW 'HALT',SETON @SC86171 03246000 KW , @SC86171 03247000 * 03248000 SETDSC KW 'DISCARD',SETOFF @SC86225 03249000 KW 'KEEP',SETON @SC86225 03250000 KW , @SC86225 03251000 * 03251080 SETCLSKW KW 'APPEND',SETCLSA @SC90033 03251160 KW 'BACKUP',SETCLSR @SC90033 03251240 KW 'DISCARD',SETCLSR @SC90033 03251320 KW 'OVERWRITE',SETCLSN @SC90033 03251400 KW 'RENAME',SETCLSR @SC90033 03251480 KW , @SC90033 03251560 * 03251640 SETOVWKW KW 'DEFAULT',SETOFF @SC90033 03251720 KW 'PRESERVE',SETON @SC90033 03251800 KW , @SC90033 03251880 * 03252000 SETPAR KW 'MARK',SETOFF @SC86316 03253000 KW 'NONE',SETON @SC86316 03254000 KW , @SC86316 03255000 SET CSECT @SC90040 03255500 * 03256000 SETTABS LA 4,SETCMDOO @SC87166 03257000 BAL 14,SETSCN @SC87166 03258000 B SETTBON Turn on @SC86355 03259000 NI FL2,255-TABS Turn off @SC86355 03260000 MVC TABCNT,F0 Clear count @SC86355 03261000 B RTRN0 @SC86295 03262000 SETTBON OI FL2,TABS Turn on @SC86355 03263000 MVC TABCNT,F0 Clear count @SC86355 03264000 SR 0,0 Init previous tab @SC86355 03265000 LA 3,TABTBL Point to start of tab table @TS86100 03266000 LA 8,255 Limit on tab stops @SC86355 03267000 LA 5,TABCNT End of table @SC86355 03268000 SETTBLP ICM 2,15,LEN Any more tokens? @SC86355 03269000 BNP SETTBN No, done @SC86355 03270000 STC 0,0(3) Save previous tab @SC86355 03271000 BAL 2,SETNUM Read number @SC86355 03272000 CLM 0,1,0(3) Is this tab higher than previous? @SC86355 03273000 BNH SETTBSEQ No, tab out of sequence @TS86100 03274000 CR 3,5 Exceeded capacity? @SC86355 03275000 BNL SETTBHI Yes @TS86100 03276000 STC 0,0(3) Save tab setting @TS86100 03277000 LA 3,1(3) Bump counter @SC86355 03278000 B SETTBLP @SC86355 03279000 SETTBN LA 0,TABTBL Point to start of tab table @SC86355 03280000 SR 3,0 Get length of table @SC86355 03281000 STH 3,TABCNT Save the tab count @TS86100 03282000 B RTRN0 @SC86355 03283000 SETTBHI PTEXT 'Too many tabs' @SC86355 03284000 B SETTBER Return error @SC86355 03285000 SETTBSEQ PTEXT 'Tabs out of sequence' @TS86100 03286000 SETTBER NI FL2,255-TABS Turn off @SC86355 03287000 B SUBERR Return error @TS86100 03288000 * 03289000 SETLIN BAL 2,SETFSTR Get fixed-format string @SC86166 03290000 PTEXT 'Bad line' @SC87351 03291000 KCALL SETMSG,5,E=SUBERR Make sure it's ok @SC87351 03292000 B RTRN0 @SC86166 03293000 * 03294000 SETPRP LA 0,KPRPT Ptr to new prompt string @SC87351 03295000 KCALL SUPFNC,11 Ok it with system @SC87351 03296000 B RTRN0 @SC87351 03297000 * 03297090 SETCLSA OI FL3,APPN Set APPEND ON @SC90033 03297180 NI FL1,255-REN ... and "WARN" OFF @SC90033 03297270 B SETCLSZ @SC90033 03297360 SETCLSR OI FL1,REN Set "WARN" ON @SC90033 03297450 B SETCLSY ... and APPEND OFF @SC90033 03297540 SETCLSN NI FL1,255-REN @SC90033 03297630 SETCLSY NI FL3,255-APPN @SC90033 03297720 SETCLSZ MVC CLSNFL,0(6) Save collision code @SC90033 03297810 B RTRN0 @SC90033 03297900 * 03298000 KSETPRC , System-specific options @SC86355 03299000 * 03300000 SETCMDS CSECT @SC90040 03300030 SETALFKW KW 'LATIN1 ',SETALF1,MIN=6 Must be fixed-length @SC90040 03300060 KW 'ASCII ',SETALF1,MIN=3 @SC90040 03300090 KW 'CYRILLIC',SETALF1,MIN=3 @SC90040 03300120 KW 'GREEK ',SETALF1,MIN=3 @SC90040 03300150 KW 'HEBREW ',SETALF1,MIN=3 @SC90040 03300180 KW 'KATAKANA',SETALF1,MIN=3 @SC90040 03300210 KW , @SC90040 03300240 SETFALFK KW 'EBCDIC ',SETALF1,MIN=6 @SC90040 03300270 KW 'CP037 ',SETALF1,MIN=5 @SC90040 03300300 KW 'CP273 ',SETALF1,MIN=5 @SC90040 03300330 KW 'CP275 ',SETALF1,MIN=5 @SC90040 03300360 KW 'CP277 ',SETALF1,MIN=5 @SC90040 03300390 KW 'CP278 ',SETALF1,MIN=5 @SC90040 03300420 KW 'CP280 ',SETALF1,MIN=5 @SC90040 03300450 KW 'CP282 ',SETALF1,MIN=5 @SC90040 03300480 KW 'CP284 ',SETALF1,MIN=5 @SC90040 03300510 KW 'CP285 ',SETALF1,MIN=5 @SC90040 03300540 KW 'CP297 ',SETALF1,MIN=5 @SC90040 03300570 KW 'CP290 ',SETALF1,MIN=5 @SC90040 03300600 KW 'CP424 ',SETALF1,MIN=5 @SC90040 03300630 KW 'CP500 ',SETALF1,MIN=5 @SC90040 03300660 KW 'CP871 ',SETALF1,MIN=5 @SC90040 03300690 KW 'CP875 ',SETALF1,MIN=5 @SC90040 03300720 KW 'DKOI ',SETALF1,MIN=4 @SC90040 03300750 KW , @SC90040 03300780 * 03300810 SETFKW KW 'LRECL',SHOLR **COMPAT** @SC87166 03301000 KW 'LONGLINE',SHOLNG,MIN=2 **COMPAT** @SC88120 03301500 KW 'COLLISION',SHOCLSN,MIN=2 **COMPAT** @SC90033 03301600 KW 'OVERWRITE',SHOOVWR **COMPAT** @SC90033 03301700 KW 'T',SETFT **COMPAT** @SC87166 03302000 KW 'TYPE',SHOFILT **COMPAT** @SC87166 03303000 KFILKW , **COMPAT** @SC87166 03304000 KW 'CHARACTER-SET',SHOFALF,MIN=2 @SC90040 03304500 SETFIL KW 'TEXT',SETFILET @SC86133 03305000 KW 'BINARY',SETFILEB @SC86262 03306000 SETDBIN KW 'D-BINARY',SETFILEB @SC86262 03307000 KW 'V-BINARY',SETFILEB @SC86151 03308000 KW 03309000 SET CSECT @SC90040 03309500 * 03310000 SETALF1 MVC 0(L'TRNALF,8),5(1) @SC90040 03310100 LR 0,8 Pass ptr to the changed code @SC90040 03310200 KCALL TBLSET,ATOE Set up translations @SC90040 03310300 B RTRN @SC90040 03310400 * 03310500 SETFILEB OI FL1,BINF Set binary on 03311000 SETFLR MVC TYPFIL,0(6) Save type @SC88120 03313000 B RTRN0 @SC86295 03316000 * 03317000 SETFILET NI FL1,255-BINF Set it OFF 03318000 B SETFLR @SC87012 03319000 * 03319100 SETCMDS CSECT @SC90040 03319150 SETLNGKW KW 'FOLD',SETLNG @SC88120 03319200 KW 'HALT',SETLNG @SC88120 03319300 KW 'TRUNCATE',SETLNG @SC88120 03319400 KW , @SC88120 03319500 SET CSECT @SC90040 03319550 SETLNG MVC TRNCFL,0(6) Save flag @SC88120 03319600 B RTRN0 @SC88120 03319700 * 03320000 KFILSET , @SC87012 03321000 * 03322000 SETDEB BAL 4,SETSCN Select among possibilities @SC88168 03323000 KW 'ON',SETDON @SC88168 03323500 KW 'OFF',SETDEND,MIN=2 @SC88168 03324000 SETRAW KW 'RAW',SETDRAW @SC88168 03324500 KW 'I/O',SETDIO @SC88168 03325000 KW 'SAVE',SETDSV @SC88168 03325500 KW , @SC88168 03326000 SETDEBOF NI FL1,255-DEBUG Set it OFF 03327000 CLOSF LOGPTR Done logging @SC86135 03329000 B RTRN0 @SC86295 03330000 * 03331000 SETDRAW OI SHODBG,DBGON+DBGRW RAW -> ON @SC88168 03332000 B SETDB1 @SC88168 03332200 SETDIO OI SHODBG,DBGON+DBGIO I/O -> ON @SC88168 03332400 B SETDB1 @SC88168 03332600 SETDSV OI SHODBG,DBGON+DBGSV SAVE-> ON @SC88168 03332800 B SETDB1 @SC88168 03333000 SETDON OI SHODBG,DBGON @SC88168 03333200 SETDB1 ICM 2,15,LEN Any more options? @SC88168 03333400 BP SETDEB Yes, interpret them @SC88168 03333600 SETDEND XC SHODBG,DBGFLG Get changed flags in SHODBG @SC88168 03333800 XC DBGFLG,SHODBG Install new flags @SC88168 03334000 TM SHODBG,DBGON ON/OFF changed? @SC88168 03334200 BZ RTRN0 No, done @SC88168 03334400 TM DBGFLG,DBGON Turned ON? @SC88168 03334600 BZ SETDEBOF No, turn it off @SC88168 03334800 NI LOGFLGS,255-APPN @SC86295 03336000 LA 0,L'LOGNAM Name string length @SC86295 03337000 LA 1,LOGNAM and address @SC86295 03338000 STM 0,1,SCANPTR @SC86295 03339000 LA 0,FFRCF @SC86295 03340000 KCALL FSPEC,IFILE Convert to filespec @SC86295 03341000 PTEXT 'DEBUG error' @SC87012 03342000 OPENF O,IFILE,LOGFDB,LOGPTR,E=SUBERR @SC87012 03343000 OI FL1,DEBUG Enable logging @SC87012 03344000 MVI ERRNUM,ERRNOE Insist no errors @SC88168 03344500 B RTRN0 @SC86295 03345000 * 03346000 SET8B NTOKN N=SET8BH,H=SET8BH @SC87008 03347000 LA 4,AAMP Default value @SC87008 03348000 LA 9,SET8BS @SC87008 03349000 SCAN SETONKW,RTRN2 03350000 SR 4,4 Zero value means OFF @SC87008 03351000 LTR 7,7 Length=1? @SC87008 03352000 BNZ SET8BS No, can't be ON @SC87008 03353000 BAL 2,SETQCH2 Make sure it's valid @SC87008 03354000 SET8BS STC 4,EBQC New value @SC87008 03355000 B RTRN0 @SC87008 03356000 SET8BH PTEXT 'Must be ON, OFF, or a character' @SC87008 03357000 B SUBERR @SC87008 03358000 * 03359000 SETSTR LR 2,14 @SC87268 03360000 MVI 0(8),0 Default to blank @SC87166 03361000 BAL 9,WSP Remaining data length @SC86224 03362000 B RTRN0 Null string @SC86295 03363000 LR 1,4 Max length allowed @SC87268 03364000 CR 6,1 @SC86345 03365000 BH SETSTRH Too long @SC86345 03366000 STC 6,0(8) Save length @SC87166 03367000 LA 8,1(8) Skip over length byte @SC87268 03368000 XR 6,7 Exchange ptr and length @SC87268 03369000 XR 7,6 @SC87268 03370000 XR 6,7 @SC87268 03371000 B SETFST1 Go copy string @SC87268 03372000 * 03373000 SETRCTLQ BAL 2,SETQCHR Get a char for Receive-Ctl-quote 03374000 STC 4,RCTLQ(5) Set receive ctl quote @SC86164 03375000 LTR 5,5 Done if SEND @SC86223 03376000 BNZ RTRN0 @SC86295 03377000 STC 4,DEFPARM+5 Set default for SPAR @SC86120 03378000 B RTRN0 @SC86295 03379000 * 03380000 SETQCHR NTOKN H=SETQCHRH,N=SETQCHRH 03381000 LTR 7,7 Token length - 1 03382000 BP SETQCHRH Pos: token is too long 03383000 SETQCH2 SR 4,4 @SC87008 03384000 IC 4,0(6) Get the quote char @SC86120 03385000 IC 4,ETOAD(4) Get ASCII form @SC89301 03386000 NOTQR SETQCHRH Go if not 33-62 or 96-126 @SC86120 03387000 BR 2 03388000 * 03389000 SETQCHRH PTEXT 'One char with ASCII value 33-62 or 96-126' @SC86224 03390000 B SUBERR @SC86295 03391000 * 03392000 SETLR ST 0,MAXOUT Max output buffer size @SC87166 03393000 B RTRN0 @SC86295 03394000 * 03395000 SETTIMO BCT 5,RTRN0 Done if rec @SC87166 03396000 TOCHR 0,,DEFPARM+1 Set default for SPAR @SC86164 03397000 B RTRN0 @SC86295 03398000 * 03399000 SETPADN BCT 5,RTRN0 Done if rec @SC87166 03400000 TOCHR 0,,DEFPARM+2 Set default for SPAR @SC86164 03401000 B RTRN0 @SC86295 03402000 * 03403000 SETPADC BCT 5,RTRN0 Done if rec @SC87166 03404000 CTL 0,,DEFPARM+3 Set default for SPAR @SC86164 03405000 B RTRN0 @SC86295 03406000 * 03407000 SETEOL BCT 5,RTRN0 Done if rec @SC87166 03408000 STC 0,S1EOL Extra copy for prompting @SC87274 03409000 TOCHR 0,,DEFPARM+4 Set default for SPAR 03410000 B RTRN0 @SC86295 03411000 * 03412000 SETSIZ C 0,AKMIN Less than min Kermit size? @SC87166 03413000 BL SETKSIZH Yes, error @SC86164 03414000 C 0,AKMAX More than max Kermit size? @SC86164 03415000 BNH SETRPS1 No, skip message call @TB86196 03416000 LTR 5,5 SEND? @SC86224 03417000 BNZ SETKSIZH Yes, can't set it long @SC86224 03418000 LR 6,0 Save value across WTEXT @SC86316 03419000 WTEXT 'Type 0 long packets specified' @SC86202 03420000 LR 0,6 @SC86316 03421000 SETRPS1 DS 0H @TB86196 03422000 BCT 5,RTRN0 Done if recv @SC86295 03423000 TOCHR 0,,DEFPARM+0 Set default for SPAR 03424000 B RTRN0 @SC86295 03425000 * 03426000 SETKSIZH PTEXT 'Operand must be 20-94 for SEND' KMIN-KMAX @SC86295 03427000 B SUBERR @SC86295 03428000 * 03429000 SETETOA LA 3,ETOA Address of table to change @SC86265 03430000 NI ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03430500 B SETTET2 @SC87117 03431000 SETTET LA 3,TETOA Address of table to change @SC87117 03432000 SETTET2 LA 2,ETOAD Address of original @SC87117 03433000 SETTR0 ICM 0,15,LEN Any more tokens? @SC87117 03434000 BP SETTR1 Yes, must be numeric @SC87117 03435000 MVC 0(256,3),0(2) No, just reset table @SC87117 03436000 B RTRN0 @SC87117 03437000 SETTR1 LA 8,255 Limit for each @SC87117 03438000 BAL 2,SETNUM Get a number for table offset @SC86295 03439000 AR 3,0 Save table offset here @SC86295 03440000 BAL 2,SETNUM Get a number for value @SC86295 03441000 STC 0,0(3) Change value @SC86295 03442000 B RTRN0 All done @SC86295 03443000 * 03444000 SETATOE LA 3,ATOE Adr of table to edit @SC86265 03445000 NI ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03445500 B SETTAT2 @SC87117 03446000 SETTAT LA 3,TATOE Address of table to change @SC87117 03447000 SETTAT2 LA 2,ATOED Address of original @SC87117 03448000 B SETTR0 Use common routine 03449000 * 03450000 * 03451000 * R6 points to token, R7 has length-1. Convert to binary in R0. 03452000 * Return via R2 03453000 SETNUM2 LR 2,14 Save return @SC87166 03454000 SETNUM NTOKN H=SETNUMH,N=SETNUMH @SC86295 03455000 LA 7,1(7) Length @SC86316 03456000 BAL 14,GETNUM @SC86316 03457000 B SETNUMH @SC86316 03458000 CLR 0,8 Within limit? @SC86295 03459000 BH SETNUMH Too big @SC87166 03460000 CLI 0(2),X'47' Entered at SETNUM2? @SC87166 03461000 BNER 2 No, return immediately @SC87166 03462000 LR 14,2 Ptr to caller @SC87166 03463000 S 14,F8 Back up to the LOAD instr @SC87166 03464000 MVC SETXI,0(14) Copy and modify op instr @SC87166 03465000 NC SETXI(2),=X'F60F' @SC87166 03466000 CLI SETXI,X'B6' Was is ICM? @SC87166 03467000 BNE *+8 No, ok @SC87166 03468000 MVI SETXI,X'BE' Yes, make into STCM @SC87166 03469000 EX 0,SETXI Store value @SC87166 03470000 BR 2 Return @SC87166 03471000 * 03472000 SETNUMH LA 15,CMD+16 @SC86295 03473000 SETMAXH MVC CMD(26),=C'Operand must be of length ' @SC86295 03474000 MVI 0(15),C'<' @SC86295 03475000 LA 15,1(15) @SC86295 03476000 LR 4,8 @SC86345 03477000 A 4,F1 @SC86345 03478000 BAL 2,EDDEC Put limit into message @SC86295 03479000 LR 4,15 End @SC86295 03480000 LA 3,CMD @SC86295 03481000 SR 4,3 @SC86295 03482000 B SUBERR @SC86295 03483000 * 03484000 SETFSTR LR 1,9 Save length @SC87166 03485000 NTOKN N=SETFST0,H=SETSTRH @SC87166 03486000 LA 7,1(7) @SC86295 03487000 CR 7,1 Name too long? @SC86295 03488000 BNH SETFST1 No, do it @SC86295 03489000 SETSTRH LR 8,1 Copy max length @SC86295 03490000 LA 15,CMD+26 Base message size @SC86295 03491000 B SETMAXH @SC86295 03492000 SETFST0 SR 7,7 Empty string @SC86295 03493000 SETFST1 ICM 7,8,BLANK Set for blank fill @SC86295 03494000 LR 9,1 @SC87166 03495000 MVCL 8,6 Copy name @SC87166 03496000 BR 2 @SC86295 03497000 TITLE 'SHOW Routine - performs SHOW command options' 03498000 * Display current values in STORAG. 03499000 * Entry: SCANPTR string has option 03500000 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name 03501000 * ERRNUM unchanged 03502000 SHOW ENTER ALT @SC86133 03503000 LA 0,CMD @SC86227 03504000 ST 0,SHOPTR Initialize output ptr @SC86227 03505000 MVI SETXI,X'91' TM instruction @SC87166 03506000 L 3,=A(SETCMDS) Addressibility @SC90040 03506500 NTOKN N=SHOALL @SC86133 03507000 SCAN SHOCMDAL,RTRN1 @SC88293 03508000 SHOBAD B RTRN2 Invalid operand @SC86295 03509000 * 03510000 SETCMDS CSECT @SC90040 03510500 SETCMDKW DS 0H @SC87166 03511000 KW 'ATOE',SETATOE,MIN=4 @SC87166 03512000 KW 'ETOA',SETETOA,MIN=4 @SC87166 03513000 KW 'FILE-TYPE',SHOFILT,MIN=5 @SC87166 03514000 KW 'TATOE',SETTAT,MIN=5 @SC87166 03515000 KW 'TETOA',SETTET,MIN=5 @SC87166 03516000 KW GOTO,SHOCMDS Skip over 'ALL' @SC88293 03516200 * 03516400 SHOATKW KW 'LENGTH',SHOATLN @SC90037 03516410 KW 'TYPE',SHOATTP @SC90037 03516420 KW 'DATE',SHOATDT,MIN=2 @SC90037 03516430 KW 'CREATOR',SHOATCR,MIN=2 @SC90037 03516440 KW 'ACCOUNT',SHOATACT,MIN=4 @SC90037 03516450 KW 'AREA',SHOATAR,MIN=2 @SC90037 03516460 KW 'PASSWORD',SHOATPW,MIN=2 @SC90037 03516470 KW 'BLOCKSIZE',SHOATBLK @SC90037 03516480 KW 'ACCESS',SHOATACC,MIN=3 @SC90037 03516490 KW 'ENCODING',SHOATENC @SC90037 03516500 KW 'DISPOSITION',SHOATDSP,MIN=2 @SC90037 03516510 KW 'PROTECT',SHOATPRO,MIN=2 @SC90037 03516520 KW 'ORIGIN',SHOATORG @SC90037 03516530 KW 'FORMAT',SHOATFMT @SC90037 03516540 KW 'SYS-INFO',SHOATSFO,MIN=2 @SC90037 03516550 KW 'BYTE-LENGTH',SHOATXLN,MIN=2 @SC90037 03516560 KW , @SC90037 03516570 * 03516580 SHOCMDAL KW 'ALL',SHOALL,MIN=3 @SC88293 03516600 SHOCMDS EQU * @SC90037 03516700 SHOATCM KW 'ATTRIBUTES',SHOATT,MIN=3 @SC90037 03516800 * 03517000 KW 'RECFM',SHORFM,MIN=4 @SC87012 03518000 KW 'LRECL',SHOLR @SC86133 03519000 KW 'WARNING',SHOWARN ***COMPAT*** @SC90033 03519300 KW 'APPEND',SHOAPP,MIN=3 ***COMPAT*** @SC90033 03519600 KW 'BAUD',SHOBAUD,MIN=2 ***COMPAT*** @SC90099 03519800 SHOCMDKW EQU * Must match order of code 03520000 KW 'TABS-EXPAND',SHOTABS @SC86133 03521000 KW 'EOF',SHOEOF,MIN=3 @SC86133 03522000 KW 'DEBUG',SHODEB @SC86133 03523000 KW 'BLOCK-CHECK',SHOBLK @SC86133 03524000 KW '8-BIT-QUOTE',SHO8B @SC87008 03525000 KW 'PROMPT',SHOPRP,MIN=2 @SC87268 03526000 KW 'LINE',SHOLIN,MIN=3 @SC87166 03527000 KW 'CONTROLLER',SHOTRM,MIN=3 @SC87268 03528000 KW 'HANDSHAKE',SHOHND @SC87274 03529000 KW 'SPEED',SHOBAUD,MIN=2 @SC90099 03530000 KW 'SYSCMD',SHOSYS,MIN=2 @SC86295 03532000 KW 'TTABLE',SHOTTB,MIN=2 @SC87117 03533000 KW 'DELAY',SHODLY,MIN=3 @SC86164 03534000 KW 'INCOMPLETE',SHOINC,MIN=3 @SC86225 03536000 KW 'TEST',SHOTST,MIN=4 @SC87166 03537000 KW 'SERVER-TIMEOUT',SHOSERV,MIN=3 @SC90045 03537500 KSETKW , Specific parameters @SC87166 03538000 KW 'TRANSFER',SHOTRN,MIN=2 @SC90040 03538500 KW 'FILE',SHOFIL @SC86295 03539000 KW 'MARGIN',SHOMRG @SC87253 03540000 KW 'FOREIGN',SHOFOR,MIN=3 @HF86223 03541000 KW 'RETRY',SHORETR,MIN=3 @SC86345 03542000 KW 'TAKE',SHOTAK,MIN=3 @SC86171 03543000 KW 'RECEIVE',SHORECV,MIN=3 @SC86133 03544000 KW 'SEND',SHOSEND,MIN=3 @SC86224 03545000 KW , @SC86133 03546000 SET CSECT @SC90040 03546500 * 03547000 SHOATT MVC SHOTMP(8),SCANPTR Save string ptrs @SC90037 03547010 LA 0,3 Max interesting count @SC90037 03547020 SHOATL1 NTOKN N=SHOATL2 Count tokens after ATTRIB @SC90037 03547030 BCT 0,SHOATL1 R0=3 => 0 @SC90037 03547040 SHOATL2 MVC SCANPTR(8),SHOTMP Restore 2 => 1 @SC90037 03547050 CLI SETXI,X'97' SET? 1 => 2 @SC90037 03547060 BE *+6 Yes, 2 more means "item" 0 => >2 @SC90037 03547070 BCTR 0,0 No, 1 more means "item" @SC90037 03547080 BCT 0,SHOATS Go if not "item" @SC90037 03547090 LA 4,SHOATKW List of possible items @SC90037 03547100 B SHOGRP Do the right one @SC90037 03547110 SHOATS OI SFLG,ALLF+ASRF Set to display both levels.. @SC90037 03547120 BAL 14,SHOOO Just SET ATT or SHO ATT @SC90037 03547130 OI SCAPA,8 @SC90037 03547140 LA 1,SHOATCM Point at keywork again (SHO ATT) @SC90037 03547150 LA 4,SHOATKW Do whole list @SC90037 03547160 B SHOGRP @SC90037 03547170 SHOATLN BAL 14,SHOOO Length @SC90037 03547180 OI ATFLG,ATFLNG @SC90037 03547190 SHOATTP BAL 14,SHOOO Type @SC90037 03547200 OI ATFLG,ATFTYP @SC90037 03547210 SHOATDT BAL 14,SHOOO Date @SC90037 03547220 OI ATFLG,ATFDAT @SC90037 03547230 SHOATCR BAL 14,SHOOO Creator @SC90037 03547240 OI ATFLG,ATFCRE @SC90037 03547250 SHOATACT BAL 14,SHOOO Account @SC90037 03547260 OI ATFLG,ATFACT @SC90037 03547270 SHOATAR BAL 14,SHOOO Area @SC90037 03547280 OI ATFLG,ATFARE @SC90037 03547290 SHOATPW BAL 14,SHOOO Password @SC90037 03547300 OI ATFLG,ATFPWD @SC90037 03547310 SHOATBLK BAL 14,SHOOO Blocksize @SC90037 03547320 OI ATFLG,ATFBLK @SC90037 03547330 SHOATACC BAL 14,SHOOO Access @SC90037 03547340 OI ATFL2,ATFACC @SC90037 03547350 SHOATENC BAL 14,SHOOO Encoding @SC90037 03547360 OI ATFL2,ATFENC @SC90037 03547370 SHOATDSP BAL 14,SHOOO Disposition @SC90037 03547380 OI ATFL2,ATFDSP @SC90037 03547390 SHOATPRO BAL 14,SHOOO Protection @SC90037 03547400 OI ATFL2,ATFPRO @SC90037 03547410 SHOATORG BAL 14,SHOOO Origin @SC90037 03547420 OI ATFL2,ATFORG @SC90037 03547430 SHOATFMT BAL 14,SHOOO Format @SC90037 03547440 OI ATFL2,ATFFMT @SC90037 03547450 SHOATSFO BAL 14,SHOOO System info @SC90037 03547460 OI ATFL2,ATFSFO @SC90037 03547470 SHOATXLN BAL 14,SHOOO Byte count @SC90037 03547480 OI ATFL3,ATFXLN @SC90037 03547490 B SHOGRPZ @SC90037 03547500 * 03547510 SHOALL OI SFLG,ALLF Do all @SC86295 03548000 SR 0,0 Clear screen (if fullscreen) @SC90045 03548300 KCALL SCRNIO @SC90045 03548600 LA 1,SHOCMDKW Start at beginning @SC86133 03549000 * 03550000 * Each routine begins with R1-> keyword item @SC86133 03551000 SHOTABS CLI SETXI,X'97' SET or SHOW? @SC87166 03552000 BE SETTABS @SC87166 03553000 BAL 14,SHOOO On or off @SC86133 03554000 OI FL2,TABS @SC87166 03555000 SHOTABSZ LH 5,TABCNT Count of tabs @SC86355 03556000 LA 3,TABTBL Ptr to table of tabs @SC86355 03557000 BAL 14,SHOLIST Display list of tab stops, if any @SC86355 03558000 NOP 0 @SC87166 03559000 SHOEOF BAL 14,SHOOO On or off @SC86133 03560000 OI FL2,EOFZ @SC87166 03561000 SHODEB CLI SETXI,X'97' SET or SHOW? @SC87166 03562000 BE SETDEB @SC87166 03563000 BAL 14,SHOOO 1st get ON vs. OFF @SC88168 03564000 OI FL1,DEBUG @SC88168 03565000 SHODEBZ MVC SHODBG,DBGFLG Copy flags for decoding @SC88168 03566000 LA 6,SETRAW List of options @SC88168 03567000 BAL 4,SHOMULT See if any extra flags on @SC88168 03568000 NOP 0 @SC88168 03569000 SHOBLK SR 4,4 @SC86133 03570000 LA 8,3 Limit @SC87166 03571000 IC 4,BCTC Get block check type @SC86133 03572000 BAL 14,SHONUM Print it @SC86133 03573000 B RTRN0 OK @SC87166 03574000 SHO8B LA 8,EBQC @SC87008 03575000 BAL 14,SHOCHRA Display ASCII char @SC87008 03576000 B SET8B @SC87166 03577000 SHOPRP LA 8,KPRPL Ptr to prompt @SC87268 03578000 LA 4,20 Max length @SC87268 03579000 BAL 14,SHOSTR @SC87268 03580000 B SETPRP Do any system-dependent setup @SC87351 03581000 SHOLIN LA 8,TRMLIN @SC87166 03582000 LA 9,L'TRMLIN @SC87166 03583000 BAL 14,SHOCHRN @SC87166 03584000 B SETLIN @SC87166 03585000 SHOTRM LA 4,SETTRKW @SC87166 03586000 LA 6,TRMTP @SC87166 03587000 BAL 14,SHOBRV Get full name from abbrev. @SC87166 03588000 NOP 0 @SC87166 03589000 SHOHND SR 4,4 @SC87274 03590000 IC 4,S1HND @SC87274 03591000 BAL 14,SHOCTL Print it @SC87274 03592000 B RTRN0 @SC87274 03593000 SHOBAUD L 4,BAUD @SC86164 03594000 BAL 14,SHONBIG Print it @SC86164 03595000 B RTRN0 @SC87166 03596000 SHOSYS BAL 14,SHOOO On or off @SC86295 03599000 OI FL2,PASS @SC87166 03600000 SHOTTB BAL 14,SHOOO On or off @SC87117 03601000 OI FL4,TTAB @SC87166 03602000 SHODLY L 4,LCLDLY @SC86164 03603000 BAL 14,SHONBIG Print it @SC86164 03604000 B RTRN0 @SC87166 03605000 SHOINC LA 4,SETDSC List of possibles @SC87166 03608000 BAL 14,SHOXY @SC86225 03609000 OI FL1,KEEP @SC90037 03610000 SHOTST BAL 14,SHOOO @SC87166 03611000 OI FL1,TSTF Turn on @SC87166 03612000 SHOSERV SR 4,4 @SC90045 03612200 IC 4,TIMOSRV Server timeout (also switch) @SC90045 03612400 BAL 14,SHONBIG @SC90045 03612600 B RTRN0 Index for server @SC90045 03612800 * 03613000 KSHOPRC , System-specific options @SC86355 03614000 * 03615000 SHOTRN LA 4,SHOTRNKW Ptr to sublist @SC90040 03615300 BAL 14,SHOGRP @SC90040 03615600 SHOFIL LA 4,SHOFILKW Ptr to sublist @SC87166 03616000 CLI SETXI,X'97' SET or SHOW **COMPAT** @SC87166 03617000 BNE *+8 SHOW **COMPAT** @SC87166 03618000 LA 4,SETFKW SET **COMPAT** @SC87166 03619000 BAL 14,SHOGRP @SC86295 03620000 SHOMRG LA 4,SHOMRGKW Ptr to sublist @SC87253 03621000 BAL 14,SHOGRP @SC87253 03622000 SHOFOR LA 4,SHOFORKW Ptr to sublist @SC87166 03623000 BAL 14,SHOGRP @SC86224 03624000 SHORETR LA 4,SHORETKW Ptr to sublist @SC87166 03625000 BAL 14,SHOGRP @SC86345 03626000 SHOTAK LA 4,SHOTAKKW Ptr to sublist @SC87166 03627000 BAL 14,SHOGRP @SC86224 03628000 SHORECV SR 5,5 Index for recv @SC86224 03629000 BAL 14,SHOGRPR @SC86224 03630000 SHOSEND LA 5,1 Index for send @SC86224 03631000 LA 14,SHOZZW @SC87166 03632000 SHOGRPR LA 4,SHORECKW Ptr to common sublist @SC87166 03633000 SHOGRP LR 2,14 Save return adr @SC87166 03634000 STM 1,4,SHOTMP Save top level ptr, return adr @SC87166 03635000 TM SFLG,ALLF Doing all? @SC86295 03637000 BO SHORAL2 Yes @SC86133 03638000 SETSCN LR 2,14 Copy return adr (again) @SC87166 03638500 NTOKN N=SHORALL @SC86133 03639000 LR 9,2 ??? @SC87166 03640000 SCAN (4),RTRN1 @SC87166 03641000 SHOHLP HELP (4),RTRN1 @SC87166 03642000 * 03643000 SETCMDS CSECT @SC90040 03643200 SHOTRNKW KW 'CHARACTER-SET',SHOALF @SC90040 03643400 KW , @SC90040 03643600 * 03643800 SHOFILKW KW 'TYPE',SHOFILT @SC86295 03644000 KW 'LONGLINE',SHOLNG,MIN=2 @SC88120 03644500 KW 'COLLISION',SHOCLSN,MIN=2 @SC90033 03644600 KW 'OVERWRITE',SHOOVWR @SC90033 03644700 KW 'LRECL',SHOLR @SC86133 03645000 KFILKW @SC87166 03646000 KW 'CHARACTER-SET',SHOFALF @SC90040 03646500 KW , @SC87012 03647000 * 03648000 SHOMRGKW KW 'LEFT',SHOLFT @SC87253 03649000 KW 'RIGHT',SHORGT @SC87253 03650000 KW , @SC87253 03651000 * 03652000 SHORECKW KW 'END-OF-LINE',SHOEOL @SC86133 03653000 KW 'END-OF-PACKET',SHOEOL @SC86133 03654000 KW 'EOL',SHOEOL,MIN=3 @SC86133 03655000 SHOPSKW KW 'PACKET-SIZE',SHOSIZ @SC86133 03656000 KW 'PAD-CHAR',SHOPADC,MIN=5 @SC86164 03657000 KW 'PADDING',SHOPADN,MIN=3 @SC86164 03658000 KW 'QUOTE',SHOQUO @SC86133 03659000 KW 'START-OF-PACKET',SHOMARK @SC86133 03660000 KW 'TIMEOUT',SHOTIMO @SC86164 03661000 KW 'PARITY',SHOPRTY @SC88288 03661500 KW , @SC86133 03662000 * 03663000 SHOTAKKW KW 'ECHO',SHOECO,MIN=3 @SC86171 03664000 KW 'ERROR-ACTION',SHOHLT,MIN=3 @SC86171 03665000 KW , @SC86171 03666000 * 03667000 SHOFORKW KW 'PREFIX',SHOPFX @HF86223 03668000 KW 'SUFFIX',SHOSFX @HF86223 03669000 KW , @HF86223 03670000 * 03671000 SHORETKW KW 'INITIAL',SHORETI @SC86345 03672000 KW 'PACKETS',SHORETN @SC86345 03673000 KW , @SC86345 03674000 SET CSECT @SC90040 03674500 * 03675000 SHORALL OI SFLG,ALLF+ASRF Do just all send/recv items @SC86295 03676000 LA 14,SHOHLP Just help if SET @SC87166 03677000 SHORAL2 BAL 2,SHOKW Get ptr to kw send or receive @SC86133 03678000 BER 14 Help for SET @SC87166 03679000 L 15,SHOPTR Output line buffer ptr @SC86227 03680000 LA 1,CMD @SC86227 03681000 SR 15,1 Anything there? @SC86227 03682000 BNP SHORAL3 No @SC86227 03683000 ST 1,SHOPTR Yes, reset ptr @SC86227 03684000 WTEXT (1),(15) And write it out @SC86227 03685000 SHORAL3 DS 0H @SC86227 03686000 MVC CMD(2),=C' ' @SC86133 03687000 MVC CMD+2(15),0(6) Copy send or receive or ... @SC89226 03688000 LA 0,CMD+2(7) Point past category @SC86316 03689000 ST 0,SHOPTR Save output ptr @SC86316 03690000 L 1,SHOTMP+12 Start at beginning @SC87166 03691000 ICM 14,7,1(1) Ptr to 1st routine @SC88168 03692000 BR 14 @SC86171 03693000 * 03694000 SHOALF LA 4,SETALFKW NOTE: this must be last parm @SC90040 03694200 LA 8,TRNALF Ptr to transfer character name @SC90040 03694400 B SHOALFC Processing same as file char set @SC90040 03694600 * 03694800 SETFT ICM 15,15,LEN SET F T ... **COMPAT** @SC87166 03695000 BNP SETFILET Nothing after: 'SET FILE-TYPE T' @SC87166 03696000 * 03697000 SHOFILT LA 4,SETFIL List of possibles @SC86151 03698000 LA 6,TYPFIL @SC87166 03699000 BAL 14,SHOBRV Get full name from abbrev. @SC87166 03700000 NOP 0 @SC87166 03701000 SHOLNG LA 4,SETLNGKW List of possibles @SC88120 03701200 LA 6,TRNCFL @SC88120 03701400 BAL 14,SHOBRV Get full name from abbrev. @SC88120 03701600 NOP 0 @SC88120 03701800 SHOCLSN LA 4,SETCLSKW List of COLLISION options @SC90033 03701820 LA 6,CLSNFL @SC90033 03701840 BAL 14,SHOBRV @SC90033 03701860 NOP 0 @SC90033 03701880 SHOOVWR LA 4,SETOVWKW List of possibles @SC90033 03701900 BAL 14,SHOXY @SC90033 03701920 OI FL3,SVATT @SC90033 03701940 SHOLR SR 4,4 @SC86133 03702000 L 8,MAXLRC Upper limit @SC87166 03703000 ICM 4,3,FILLRC @SC88120 03704000 BAL 14,SHONUM Print it @SC86133 03705000 B SETLR @SC87166 03706000 KFILSHO , @SC87012 03707000 SHOFALF LA 4,SETFALFK NOTE: this must be last parm @SC90040 03707100 LA 8,FILALF Ptr to file character name @SC90040 03707200 SHOALFC LA 9,L'TRNALF @SC90040 03707300 BAL 14,SHOCHRN Get name @SC90040 03707400 B SETSCN @SC90040 03707500 B SHOGRPZ @SC86295 03708000 * 03709000 SHOLFT L 4,LMARG @SC87253 03710000 BAL 14,SHONBIG Print it @SC87253 03711000 B RTRN0 @SC87253 03712000 SHORGT L 4,RMARG @SC87253 03713000 BAL 14,SHONBIG Print it @SC87253 03714000 B RTRN0 @SC87253 03715000 B SHOGRPZ @SC87253 03716000 * 03717000 SHOWARN BAL 14,SHOOO On or off ***COMPAT*** @SC90033 03717100 OI FL1,REN @SC90033 03717200 SHOAPP BAL 14,SHOOO On or off ***COMPAT*** @SC90033 03717300 OI FL3,APPN @SC90033 03717400 * 03717500 SHOECO BAL 14,SHOOO On or off @SC86171 03718000 OI FL2,ECHO @SC87166 03719000 SHOHLT LA 4,SETSWT List of possibles @SC87166 03720000 BAL 14,SHOXY @SC86171 03721000 OI FL5,TKHLT @SC87166 03722000 B SHOGRPZ @SC86171 03723000 * 03724000 SHOPFX LA 8,PREFIX Point to prefix @HF86223 03725000 LA 4,FORMAXL Max length @SC87268 03726000 BAL 14,SHOSTR Print message @SC86224 03727000 B RTRN0 @SC87268 03728000 SHOSFX LA 8,SUFFIX Point to suffix @HF86223 03729000 LA 4,FORMAXL Max length @SC87268 03730000 BAL 14,SHOSTR Print message @SC86224 03731000 B RTRN0 @SC87268 03732000 B SHOGRPZ @HF86223 03733000 * 03734000 SHORETI L 4,MAXTNT Initial retry limit @SC86345 03735000 BAL 14,SHONBIG Print it @SC87166 03736000 B RTRN0 @SC87166 03737000 SHORETN L 4,MAXTRY Normal retry limit @SC86345 03738000 BAL 14,SHONBIG Print it @SC87166 03739000 B RTRN0 @SC87166 03740000 B SHOGRPZ @SC86345 03741000 * 03742000 SHOEOL SR 4,4 @SC86133 03743000 IC 4,REOL(5) @SC86133 03744000 BAL 14,SHOCTL Print it @SC87166 03745000 B SETEOL @SC87166 03746000 LA 1,SHOPSKW Skip aliases @SC86133 03747000 SHOSIZ L 8,=A(KMAXE) Limit @SC87166 03748000 LR 3,5 @SC87166 03749000 SLA 3,2 Get fullword index @SC87166 03750000 L 4,RPSIZ(3) @SC87166 03751000 BAL 14,SHONUM Print number @SC86133 03752000 B SETSIZ @SC87166 03753000 SHOPADC SR 4,4 @SC86164 03754000 IC 4,RPADC(5) Pad character @SC86164 03755000 BAL 14,SHOCTL @SC87166 03756000 B SETPADC @SC87166 03757000 SHOPADN SR 4,4 @SC86164 03758000 LA 8,KMAX Same upper limit as packets @SC87166 03759000 IC 4,RPADN(5) Pad count @SC86164 03760000 BAL 14,SHONUM @SC86164 03761000 B SETPADN @SC87166 03762000 SHOQUO LA 8,RCTLQ(5) @SC86133 03763000 BAL 14,SHOCHRA Print as ascii @SC86133 03764000 B SETRCTLQ @SC87166 03765000 SHOMARK SR 4,4 @SC86133 03766000 IC 4,RMARK(5) @SC86133 03767000 BAL 14,SHOCTL @SC87166 03768000 B RTRN0 @SC87166 03769000 SHOTIMO SR 4,4 @SC86164 03770000 IC 4,RTIMO(5) Timeout limit @SC86164 03771000 BAL 14,SHONBIG @SC87166 03772000 B SETTIMO @SC87166 03773000 SHOPRTY LA 4,SETPAR @SC88288 03773200 LA 3,RPRTY(5) Ptr to proper flag @SC88288 03773400 BAL 14,SHOXY @SC88288 03773600 OI 0(3),DAT8 @SC88288 03773800 * 03774000 SHOGRPZ TM SFLG,ASRF Doing just receive/send? @SC86295 03775000 BO SHOZZW Yes, write last line @SC86227 03776000 LM 1,2,SHOTMP Get top level ptr, return adr @SC87166 03777000 LR 14,2 @SC86224 03778000 BAL 2,SHOKW Get ptr to name @SC86133 03779000 LA 1,0(7,6) Advance to next @SC86133 03780000 BR 14 @SC86224 03781000 * 03782000 SHOMULT LR 5,1 Save ptr to current option @SC88168 03782050 LR 1,6 Use ptr to list of suboptions @SC88168 03782100 SHOMULQ ICM 14,7,1(1) Get ptr to handler (assume OI x,y)@SC88168 03782150 BAL 2,SHOKW Get ptrs to KW string, fix SETXI @SC88168 03782200 EX 0,SETXI TM x,y @SC88168 03782250 BNO SHOMULP Not this one @SC88168 03782300 MVI 0(15),C',' Yes, punctuate display @SC88168 03782350 LA 15,1(15) @SC88168 03782400 LR 8,6 @SC88168 03782450 LR 9,7 @SC88168 03782500 BAL 2,EDCHAR Copy this KW to display @SC88168 03782550 SHOMULP LA 1,0(7,6) On to next in list @SC88168 03782600 CLI 0(1),254 End of list? @SC88168 03782650 BL SHOMULQ No, keep checking @SC88168 03782700 LR 14,4 Proper place for return adr @SC88168 03782750 LR 1,5 Restore ptr to current option @SC88168 03782800 B SHOZZZ End of item @SC88168 03782850 * 03782900 SHOLIST LTR 5,5 Length of list @SC86355 03783000 BZ SHOZZ Empty, we're done @SC86355 03784000 LA 0,CMD+75 Set right margin @SC86355 03785000 MVI 0(15),C' ' Start with blank @SC86355 03786000 B *+8 @SC86355 03787000 SHOLSLP MVI 0(15),C',' Insert delimiter @SC86355 03788000 LA 15,1(15) @SC86355 03789000 CR 15,0 Any room? @SC86355 03790000 BL SHOLSED Yes, ok @SC86355 03791000 LA 1,CMD No, dump line @SC86355 03792000 SR 15,1 @SC86355 03793000 WTEXT (1),(15) @SC86355 03794000 MVI CMD,C' ' @SC86355 03795000 LA 15,CMD+1 Start indented @SC86355 03796000 LA 0,CMD+75 @SC86355 03797000 SHOLSED SR 4,4 @SC86355 03798000 IC 4,0(3) Get 1-byte item @SC86355 03799000 BAL 2,EDDEC Format it @SC86355 03800000 LA 3,1(3) Point to next item in list @SC86355 03801000 BCT 5,SHOLSLP @SC86355 03802000 B SHOZZ Finished list @SC86355 03803000 * 03804000 SHOKW MVC SETXI+1(3),1(14) Copy instr operands @SC87166 03805000 CLI SETXI,X'97' 'OI' if SET, but 'TM' if SHOW @SC87166 03806000 LA 6,5(1) Ptr to name @SC86133 03807000 LA 7,0 Preserve CC @SC86133 03808000 IC 7,0(1) Length (assumes high bytes clear) @SC88168 03809000 LA 7,1(7) @SC86133 03810000 BR 2 @SC86133 03811000 * 03812000 SHOCTL LA 8,ABL-1 Max control character (ASCII) @SC87166 03813000 TM FL1,TSTF @SC86295 03814000 BZ SHONUM @SC87166 03815000 SHONBIG L 8,=F'999999998' Almost anything @SC87166 03816000 SHONUM BAL 2,SHOKW @SC86133 03817000 BE SETNUM2 Get value for SET @SC87166 03818000 BAL 2,SHONAM Copy option name @SC86209 03819000 BAL 2,EDDEC Edit (R4) as decimal @SC86295 03820000 B SHOZZ @SC86133 03821000 * 03822000 SHOCHRA MVC TMP,0(8) Copy ascii char @SC86133 03823000 PTEXT SETOOKW+5,3,AREG=8,LREG=9 @SC88168 03824000 TM TMP,X'60' Is it printable? @SC87008 03825000 BZ SHOCHRN No, say it's OFF @SC87008 03826000 TR TMP,ATOED Convert to EBCDIC @SC89301 03827000 LA 8,TMP @SC86133 03828000 B SHOCHR @SC86224 03829000 SHOSTR BAL 2,SHOKW Get ptrs to name @SC87268 03830000 BE SETSTR Branch to dispatch for SET @SC87268 03831000 SR 9,9 Variable-length string @SC86224 03832000 IC 9,0(8) Get length @SC86224 03833000 LA 8,1(8) Ptr to text @SC86224 03834000 B SHOCHRD @SC87268 03835000 SHOCHR LA 9,1 Length is 1 @SC86224 03836000 SHOCHRN BAL 2,SHOKW Get ptrs to name @SC86224 03837000 BER 14 Branch to dispatch for SET @SC87166 03838000 SHOCHRD BAL 2,SHONAM Copy option name @SC87268 03839000 BAL 2,EDCHAR Append string at (R8) @SC87034 03840000 B SHOZZ Print message @SC87034 03841000 * 03842000 SHOBRV CLI SETXI,X'97' SET or SHOW? @SC87166 03843000 BE SETSCN @SC87166 03844000 LR 9,14 Save return adr @SC87166 03845000 LR 8,1 Save list ptr @SC87166 03846000 LR 1,4 Use list of suboptions @SC87166 03847000 SR 7,7 Assume 1-char abbrev @SC87166 03848000 ICM 7,8,* Indicate just search @SC87166 03849000 BAL 14,SCAN @SC87166 03850000 CR 0,0 These two skipped @SC87166 03851000 LR 4,1 if bad value @SC87166 03852000 LR 1,8 Retrieve ptrs @SC87166 03853000 LR 14,9 @SC87166 03854000 B SHOXY Display it @SC87166 03855000 * 03856000 SHOOO LA 4,SETOOKW Ptr to on/off @SC87166 03857000 SHOXY BAL 2,SHOKW Set up name @SC86133 03858000 BE SETSCN Parse value for SET @SC87166 03859000 LA 8,5(4) Value if off @SC86133 03860000 SR 9,9 @SC87166 03861000 IC 9,0(4) Length of name @SC88168 03862000 EX 0,SETXI Test bit @SC87166 03863000 BZ *+12 @SC86133 03864000 LA 8,6(9,8) Flag is on, advance @SC86133 03865000 IC 9,6(9,4) @SC88168 03866000 LA 9,1(9) @SC86133 03867000 SHOXL BAL 2,SHONAM Copy option name @SC86209 03868000 BAL 2,EDCHAR Append string at (R8) @SC86295 03869000 SR 15,9 Back up to string @SC87034 03870000 TR 0(30,15),LOCASE And make it lower case @SC87034 03871000 AR 15,9 Resume @SC87034 03872000 SHOZZ LA 1,0(7,6) Advance to next option @SC88168 03873000 SHOZZZ ST 15,SHOPTR Save end of display buffer @SC88168 03874000 L 3,=A(SETCMDS) Recover base reg. @SC90040 03874500 LA 14,4(14) Skip over SET branch @SC87166 03875000 CLM 14,7,=AL3(SHOTABSZ) @SC86355 03876000 BER 14 Special treatment for tabs @SC86355 03877000 CLM 14,7,=AL3(SHODEBZ) @SC88168 03877300 BER 14 Special treatment for DEBUG, too @SC88168 03877600 TM SFLG,ALLF Doing all? @SC86295 03878000 BOR 14 And resume if yes @SC86227 03879000 SHOZZW LA 1,CMD No, get address of buffer @SC86227 03880000 SR 15,1 Get length @SC86227 03881000 WTEXT (1),(15) Write it out @SC86227 03882000 B RTRN0 That's all @SC86295 03883000 * 03884000 SHONAM LA 15,CMD Output message buffer @SC86209 03885000 L 0,SHOPTR End of prev. msg @SC86227 03886000 CR 0,15 Empty? @SC86227 03887000 BE SHON1 Yes, start here @SC86227 03888000 LA 1,CMD+23 2nd column @SC86227 03889000 SR 1,0 Far enough? @SC86227 03890000 BP SHONF Yes, blank fill @SC86227 03891000 AH 1,=H'23' Try 3rd column @SC86227 03892000 BP SHONF OK @SC86227 03893000 SR 0,15 No room, dump line @SC86227 03894000 WTEXT (15),(0) @SC86227 03895000 LA 15,CMD And start over @SC86227 03896000 B SHON1 @SC86227 03897000 SHONF SR 15,15 @SC86295 03898000 ICM 15,8,BLANK @SC86295 03899000 MVCL 0,14 Fill with blanks to next column @SC86227 03900000 LR 15,0 New output ptr @SC86227 03901000 SHON1 MVC 0(40,15),0(6) Copy option name @SC87034 03902000 TR 1(39,15),LOCASE And beautify it @SC87034 03903000 AR 15,7 Space over it @SC86209 03904000 MVC 0(4,15),=C' is ' @SC87034 03905000 LA 15,4(15) Space over 'is' @SC86209 03906000 BR 2 @SC86209 03907000 DROP 3 @SC90040 03907500 * 03908000 LOCALS , @SC86295 03909000 SHOTMP DS 4F @SC87166 03910000 SHOPTR DS A More temporaries @SC86227 03911000 SETXI DS F XI executable instr @SC86273 03912000 SFLG DS X Local flags @SC86295 03913000 ALLF EQU X'80' Doing SHOW ALL @SC86295 03914000 ASRF EQU X'40' Doing SHOW REC or SHOW SEND @SC86295 03915000 SHODBG DS X Temp for DEBUG flags @SC88168 03915500 SHOW EXIT 03916000 TITLE 'STATUS Routine - display latest error, etc.' @SC86295 03917000 * Exit: R15=0. ERRNUM unchanged. 03918000 STATUS ENTER @SC86156 03919000 CLI ERRNUM,ERRNFT Actual error? @BS86090 03920000 BNH STAMSG No @BS86090 03921000 CLI ERRNUM,ERRKCE Last command invalid? @SC86295 03922000 BE STAMSG Yes, do not show last file @HF86232 03923000 CLI FILNAM,0 File name defined? @BS86090 03924000 BE STAMSG No @BS86090 03925000 MVC CMD(16),=CL16'Last file used:' @BS86090 03926000 LA 7,CMD+16 Fill in name @BS86090 03927000 LA 1,FILNAM @SC86295 03928000 BAL 2,STAFSP Copy name and print @SC86295 03929000 STAMSG ICM 4,15,NSENT Number of files sent @SC86295 03930000 BZ STASNTZ @SC86295 03931000 LA 15,CMD Start of message buffer @SC86295 03932000 BAL 2,EDDEC Format number as decimal @SC86295 03933000 LA 0,17(15) Tentative end of message @SC86295 03934000 MVC 0(17,15),=C' files sent last.' @SC86295 03935000 BCT 4,STAPLR @SC86295 03936000 MVC 5(11,15),6(15) Only one file, make singular @SC86295 03937000 BCTR 0,0 @SC86295 03938000 STAPLR BAL 2,STAPMSG Show message @SC86295 03939000 STASNTZ ICM 0,15,PAKCNT Any transfer statistics? @SC86295 03940000 BZ STADATR No, skip it @SC86316 03941000 ICM 6,7,=C'pkt' @SC86295 03942000 BAL 3,STADPR Format msg @SC86295 03943000 ICM 0,15,SECTOT Any duration? @SC86295 03944000 BZ STADATR No, must have been very short @SC86316 03945000 ICM 6,7,=C'sec' @SC86295 03946000 BAL 3,STADPR Format msg @SC86295 03947000 MVC CMD(16),=C'Disk bytes/sec: ' @SC86295 03948000 LA 15,CMD+16 @SC86295 03949000 L 0,SECTOT @SC86295 03950000 LM 4,5,DSKTOT @SC86295 03951000 BAL 2,STAVB Format ratio @SC86295 03952000 BAL 2,STAPM15 Print line @SC86295 03953000 STADATR ICM 4,15,RTRCNT Any retries? @SC86316 03954000 BZ STADATZ No @SC86316 03955000 LA 15,CMD Yes, issue message @SC86316 03956000 BAL 2,EDDEC @SC86316 03957000 MVC 0(20,15),=C' repeat packets sent' @SC86316 03958000 LA 15,20(15) @SC86316 03959000 BAL 2,STAPM15 Print line @SC86316 03960000 XC TINSV(48),TINSV Completely clear data @SC88325 03961000 KCALL OPTPKT Get best packet size @SC88325 03962000 LTR 4,15 Valid? @SC86345 03963000 BNP STADATZ No, skip it @SC86345 03964000 MVC CMD(21),=C'Optimum packet size: ' @SC88120 03965000 LA 15,CMD+21 @SC88120 03966000 BAL 2,EDDEC Format it @SC86345 03967000 BAL 2,STAPM15 @SC86345 03968000 STADATZ ICM 4,15,RECTRC Any truncated records? @SC87268 03969000 BZ STATRCZ No, ok @SC87268 03970000 LA 15,CMD Yes, issue message @SC87268 03971000 BAL 2,EDDEC @SC87268 03972000 MVC 0(18,15),=C' records truncated' @SC87268 03973000 LA 15,18(15) @SC87268 03974000 BAL 2,STAPM15 @SC87268 03975000 STATRCZ DS 0H @SC87268 03976000 ICM 4,15,RECFLD Any folded records? @SC88120 03976100 BZ STATFDZ No, ok @SC88120 03976200 LA 15,CMD Yes, issue message @SC88120 03976300 BAL 2,EDDEC @SC88120 03976400 MVC 0(15,15),=C' records folded' @SC88120 03976500 LA 15,15(15) @SC88120 03976600 BAL 2,STAPM15 @SC88120 03976700 STATFDZ DS 0H @SC88120 03976800 SR 5,5 @SC86156 03977000 IC 5,ERRNUM Get offset into error table @SC86156 03978000 SLL 5,2 Get fullword index @SC86156 03979000 A 5,=A(ERRTAB) Pointer address @SC89215 03980000 L 1,0(5) Msg ptr @SC86156 03981000 SR 0,0 @SC86268 03982000 SLDL 0,8 Msg length @SC86316 03983000 SRL 1,8 Realign adr @SC86316 03984000 WTEXT (1),(0) Print message @SC86268 03985000 CLI ERRNUM,ERRTRC Cancelled? @SC86316 03986000 BNE STACKAB No @SC86316 03987000 SR 1,1 @SC86316 03988000 CLI REASON,STACNN Within table? @SC90033 03989000 BH *+8 No, must be new @SC86316 03990000 IC 1,REASON Ok, get the complaint code @SC86316 03991000 SLL 1,3 Index into table @SC86316 03992000 LA 1,STACNTB(1) @SC86316 03993000 LA 0,8 Length of items @SC86316 03994000 WTEXT (1),(0) @SC86316 03995000 STACKAB CLI ERRNUM,ERRABO Micro aborted? @BS86090 03996000 BE *+12 Yes @SC87338 03997000 CLI ERRNUM,ERRDIE No, disk I/O error? @SC87338 03998000 BNE STARET No @BS86090 03999000 ICM 0,15,EMSGL Yes, any message? @SC86268 04000000 BZ STARET No @BS86090 04001000 L 1,EMSGP @BS86090 04002000 WTEXT (1),(0) Yes, show it @SC86268 04003000 STARET TM FL1,TSTF @SC89089 04004000 BZ RTRN0 Skip this message unless testing @SC89089 04004070 LM 3,4,STKLO Get start and end of stack use @SC89089 04004140 SR 4,3 Get length (is mult. of 8) @SC89089 04004210 SRL 4,3 Convert to doublewords @SC89089 04004280 LA 15,CMD Sart of msg buffer @SC89089 04004350 BAL 2,EDDEC Format number @SC89089 04004420 MVC 0(22,15),=C' dwords of stack used.' @SC89089 04004490 LA 0,22(,15) Point to end of msg @SC89089 04004560 BAL 2,STAPMSG @SC89089 04004630 B RTRN0 @SC89089 04004700 * 04005000 STADPR MVC CMD(13),=C'Bytes/pkt: S=' @SC86295 04006000 LA 15,CMD+13 @SC86295 04007000 STCM 6,7,CMD+6 @SC86295 04008000 LM 4,5,TOUTOT @SC86295 04009000 BAL 2,STAVB Format ratio @SC86295 04010000 MVC 0(3,15),=C' R=' @SC86295 04011000 LA 15,3(15) @SC86295 04012000 LM 4,5,TINTOT @SC86295 04013000 BAL 2,STAVB Format ratio @SC86295 04014000 MVC 0(11,15),=C' requiring ' @SC86295 04015000 LA 15,11(15) @SC86295 04016000 LR 4,0 @SC86295 04017000 BAL 2,EDDEC Format number of units @SC86295 04018000 MVI 0(15),C' ' @SC86295 04019000 STCM 6,7,1(15) @SC86295 04020000 LA 0,4(15) End of msg @SC86295 04021000 BAL 2,STAPMSG Print it @SC86295 04022000 BR 3 @SC86295 04023000 * 04024000 STAVB DR 4,0 Get ratio @SC86295 04025000 AR 4,4 @SC86295 04026000 CR 4,0 @SC86295 04027000 BL *+8 @SC86295 04028000 A 5,F1 Round up @SC86295 04029000 LR 4,5 @SC86295 04030000 B EDDEC Format it @SC86295 04031000 * 04032000 * Table of reasons for rejecting Attribute packet @SC86316 04033000 STACNTB DC C'-Unknown-Length -Type -Date ' @SC86316 04034000 DC C'-Creator-Account-Area -Passwrd' @SC86316 04035000 DC C'-Blksize-Access -Encodng-Disp ' @SC90033 04036000 DC C'-Protect-Protect-Origin -Format ' @SC86316 04037000 DC C'-Sysinfo-Bytes ' @SC90033 04037200 STACNCLS EQU (*-STACNTB)/8 One extra reason stuck on the end @SC90033 04037400 DC C'-Collisn' @SC90033 04037600 STACNN EQU (*-STACNTB)/8-1 @SC90033 04037800 TITLE 'DUMP Routine - print translation table' 04038000 * Display current values in STORAG. 04039000 * Entry: SCANPTR string has option 04040000 * Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged. 04041000 DUMP ENTER ALT @SC86156 04042000 NTOKN N=DUMPH A or E? @SC86156 04043000 SCAN DUMPKW,RTRN1 @SC86295 04044000 DUMPH HELP DUMPKW,RTRN1 @SC86295 04045000 * 04046000 DUMPKW KW 'ATOE',DUMPA @SC86156 04047000 KW 'ETOA',DUMPE @SC86156 04048000 KW 'NAMES',DMPN @SC86295 04049000 KW 'TATOE',DUMPTA,MIN=2 @SC87117 04050000 KW 'TETOA',DUMPTE,MIN=2 @SC87117 04051000 KW , @SC86156 04052000 * 04053000 DMPN L 5,TSENT Table ptr @SC86295 04054000 ICM 6,15,NSENT Number of files sent @SC86295 04055000 BNZ DMPNL @SC86295 04056000 WTEXT 'No files sent' @SC86295 04057000 B RTRN0 @SC86295 04058000 DMPNL LA 7,CMD Start of message buffer @SC86295 04059000 LA 0,FFDSP @SC88092 04060000 KCALL FSPEC,(5) Copy name for display @SC88092 04060100 MVC 0(2,15),=C' (' @SC88092 04060200 LA 15,2(15) @SC88092 04060300 ICM 4,15,LFID(5) Get file size @SC88092 04060400 BAL 2,EDDEC Format into message @SC88092 04060500 MVC 0(2,15),=C'k)' @SC88092 04060600 LA 15,2(15) @SC88092 04060700 SR 2,2 @SC88092 04060800 ICM 2,1,LFID+4(5) Get corresponding error code @SC88092 04060900 BZ DMPNN No error, that's fine @SC88092 04061000 SLL 2,2 @SC88092 04061100 A 2,=A(ERRTAB) Get ptr into error table @SC89215 04061200 SR 3,3 @SC88092 04061300 IC 3,0(2) Length of message @SC88092 04061400 L 2,0(2) And message ptr @SC88092 04061500 MVC 0(4,15),=C' -- ' @SC88092 04061600 MVC 4(50,15),0(2) Copy message @SC88092 04061700 LA 15,4(3,15) @SC88092 04061800 DMPNN BAL 2,STAPM15 Display name (+ error) @SC88092 04061900 A 5,FLFID1 Next filespec @SC88092 04062000 BCT 6,DMPNL @SC86295 04063000 B RTRN0 @SC86295 04064000 * 04065000 DUMPA LA 3,ATOE @SC86156 04066000 B DUMPAE @SC86156 04067000 DUMPE LA 3,ETOA @SC86156 04068000 B DUMPAE @SC87117 04069000 DUMPTA LA 3,TATOE @SC87117 04070000 B DUMPAE @SC87117 04071000 DUMPTE LA 3,TETOA @SC87117 04072000 DUMPAE LA 4,4 Bytes per word @SC86156 04073000 LA 5,15(3) End of 1st line @SC86156 04074000 LA 6,16 Bytes per line @SC86156 04075000 LA 7,256(3) 2 before end of table @SC86156 04076000 DUMPLL LA 2,CMD Output buffer @SC86156 04077000 DUMPLW UNPK 0(9,2),0(5,3) Convert a word @SC86156 04078000 TR 0(8,2),TRHEX Hex notation @SC86156 04079000 MVI 8(2),C' ' Leave a space between words @SC86156 04080000 LA 2,9(2) @SC86156 04081000 BXLE 3,4,DUMPLW Do next word @SC86156 04082000 LA 1,CMD Done line of 4 @SC86156 04083000 LA 0,35 @SC86268 04084000 WTEXT (1),(0) Print it @SC86268 04085000 BXLE 5,6,DUMPLL Done line, go to next @SC86156 04086000 B RTRN0 04087000 TITLE 'GIVTAB Routine - save translation table' 04088000 * Save current values in STORAG into a TAKE file on disk 04089000 * Entry: SCANPTR string has option 04090000 * Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM set 04091000 * appropriately as long as command syntax is ok, else unchanged. 04091500 GIVTAB ENTER ALT @SC87117 04092000 NTOKN N=GIVH A or E? @SC87117 04093000 SCAN GIVKW,RTRN1 @SC87117 04094000 GIVH HELP GIVKW,RTRN1 @SC87117 04095000 * 04096000 GIVKW KW 'ATOE',GIVA @SC87117 04097000 KW 'ETOA',GIVE @SC87117 04098000 KW 'TATOE',GIVTA,MIN=2 @SC87117 04099000 KW 'TETOA',GIVTE,MIN=2 @SC87117 04100000 KW , @SC87117 04101000 * 04102000 GIVA LA 6,ATOE-ATOE ATOE table is first in storage @SC90040 04103000 B GIVSET @SC90040 04103300 GIVE LA 6,ETOA-ATOE i.e., 256 @SC90040 04103600 GIVSET LR 7,1 Save ptr to cmd option @SC90040 04103900 XR 0,0 Quit if invalid pair @SC90040 04104200 L 1,CBUF @SC90040 04104500 KCALL TBLSET,E=RTRN1 Load base tables into CBUF @SC90040 04104800 LA 0,0(6,1) R0->base table @SC90040 04105100 LA 6,ATOE-1(6) R6->working table - 1 @SC90040 04105400 LR 1,7 R1->item in keywords list @SC90040 04105700 B GIVAE @SC90040 04106000 GIVTA LA 6,TATOE-1 @SC87117 04107000 GIVA1 LA 0,ATOED @SC87117 04108000 B GIVAE @SC87117 04109000 GIVTE LA 6,TETOA-1 @SC87117 04110000 GIVE1 LA 0,ETOAD @SC87117 04111000 GIVAE SR 15,15 @SC87117 04112000 IC 15,0(1) Get length of name @SC88298 04113000 MVC GIVBUF(4),=C'SET ' @SC87117 04114000 MVC GIVBUF+4(10),5(1) Copy name to command @SC87117 04115000 LA 15,GIVBUF+5(15) @SC87117 04116000 MVI 0(15),C' ' @SC87117 04117000 LA 15,1(15) Get ptr for 1st argument @SC87117 04118000 LR 1,0 @SC87117 04119000 BCTR 0,0 Back up to start at "difference" @SC87117 04120000 STM 15,1,GIVSV Save ptrs: cmd, table, table start@SC87117 04121000 LA 7,257 Table length + 1 @SC87117 04122000 LA 0,FFGIV @SC87117 04123000 KCALL FSPEC,FILNAM,E=GIVFNE Error @SC87117 04124000 MVI ERRNUM,ERRNOE Ok now @SC87117 04125000 OPENF O,FILNAM,LOGFDB,GIVPTR,E=GIVOPERR @SC87117 04126000 GIVLP LM 15,0,GIVSV Get output ptr, table scan ptr @SC87117 04127000 LA 6,1(6) Skip last difference @SC87117 04128000 AH 0,*-2 @SC87117 04129000 BCTR 7,0 New length left @SC87117 04130000 LR 1,7 Copy length @SC87117 04131000 CLCL 0,6 Find next difference @SC87117 04132000 BE GIVFIN All done @SC87117 04133000 ST 0,GIVSV+4 Save new ptr @SC87117 04134000 LR 4,0 Get offset @SC87117 04135000 S 4,GIVSV+8 @SC87117 04136000 BAL 2,EDDEC Write as decimal @SC87117 04137000 MVI 0(15),C' ' Leave space @SC87117 04138000 LA 15,1(15) @SC87117 04139000 IC 4,0(6) Get tailored character @SC87117 04140000 BAL 2,EDDEC Write as decimal @SC87117 04141000 LA 2,GIVBUF @SC87117 04142000 SR 15,2 Length of line @SC87117 04143000 WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR @SC87117 04144000 B GIVLP @SC87117 04145000 GIVWRERR CLOSF GIVPTR Close output file @SC87117 04146000 GIVOPERR PTEXT 'Unable to write file' @SC87117 04147000 GIVFNE WTEXT (3),(4) Show message @SC87117 04148000 B RTRN1 @SC87117 04149000 GIVFIN CLOSF GIVPTR,E=GIVOPERR Close output file @SC87117 04150000 B RTRN0 @SC86295 04151000 LOCALS , @SC86295 04152000 GIVSV DS 3F Saved ptrs for saving table @SC87117 04153000 GIVPTR DS A Ticket for disk I/O @SC87117 04154000 GIVBUF DS CL25 Buffer for new file @SC87117 04155000 EXIT @SC86164 04156000 TITLE 'OPTPKT Routine - compute optimum packet size' @SC88325 04156010 * Entry: TINSV contains stack of data 04156020 * Exit: R15=0 if no limit, else optimum packet size 04156030 OPTPKT ENTER , @SC88325 04156040 LM 1,2,TINTOT Get byte count @SC88325 04156050 AL 2,TOUTOT+4 @SC88325 04156060 BC 12,*+8 @SC88092 04156070 AL 1,F1 @SC88325 04156080 AL 1,TOUTOT @SC88325 04156090 LM 3,4,PAKCNT Get packets, errors @SC88325 04156100 L 5,CSECTOT Get time (elapsed, if done) @SC88325 04156110 LM 6,9,TINSV 3rd-last snapshot @SC88325 04156120 MVC TINSV(32),TINSV+16 Shift snapshots back @SC88325 04156130 STM 2,5,TINSV+32 And insert latest @SC88325 04156140 LTR 4,4 Any errors ever? @SC88325 04156150 BZ RTRN0 No, use max buffer @SC88325 04156160 SLR 2,6 Get incremental counts: bytes, @SC88325 04156170 SR 3,7 ... packets, @SC88325 04156180 BP *+8 @SC89275 04156183 LA 3,1 Mustn't divide by 0! @SC89275 04156186 SR 4,8 ... errors, @SC88325 04156190 BP *+8 @SC88325 04156200 LA 4,1 Mustn't divide by 0! @SC88325 04156210 SR 5,9 ... and csec. @SC88325 04156220 BNM *+8 @SC88325 04156230 A 5,=F'1759218604' Wraps by 2**44/10000 @SC88325 04156240 LR 7,4 Save error count @SC88325 04156250 M 4,BAUD Total possible transmission @SC88325 04156260 C 4,=F'500' @SC88325 04156270 BNL RTRN0 @SC88325 04156280 D 4,=F'1000' Correct for 10 baud, 100 csec @SC88325 04156290 SR 5,2 Possible - actual @SC88325 04156300 BNP RTRN0 ?? @SC88325 04156310 MR 6,3 Errors * packets @SC88325 04156320 SLA 3,4 Packets * 16 (16 apprx 19) @SC88325 04156330 SR 2,3 Useful bytes @SC88325 04156340 LR 3,2 @SC88325 04156350 SLR 2,2 Prepare divide @SC88325 04156360 DR 2,7 @SC88325 04156370 MR 2,5 @SC88325 04156380 * Compute sq rt of value in (2,3), return in 15. Uses 2,3,4,5,14. 04156390 SQRT LR 14,2 Copy for sqrt @SC86345 04156400 LR 15,3 @SC86345 04156410 LA 4,31 Count bits @SC86345 04156420 SQRL1 CL 2,=XL4'10000000' @SC86345 04156430 BNL SQRL2 Justified now @SC86345 04156440 SLDL 2,2 Keep shifting @SC86345 04156450 BCT 4,SQRL1 @SC86345 04156460 SQRL2 LCR 4,4 @SC86345 04156470 AL 2,=XL4'10000000' 1st guess at sqrt @SC86345 04156480 SRDL 2,62(4) Shift back @SC86345 04156490 LTR 3,3 @SC86345 04156500 BNP SQRX Too small anyway @SC86345 04156510 LA 2,3 @SC86345 04156520 SQRL3 LR 4,14 @SC86345 04156530 LR 5,15 @SC86345 04156540 DR 4,3 Get next guess @SC86345 04156550 AR 3,5 @SC86345 04156560 SRA 3,1 @SC86345 04156570 BCT 2,SQRL3 @SC86345 04156580 SQRX LR 15,3 @SC86345 04156590 B RTRN @SC88325 04156600 LOCALS , @SC88325 04156610 EXIT , @SC88325 04156620 TITLE 'GENCMD Routine - send a Generic command' @SC86155 04157000 * Entry: SCANPTR has string 04158000 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter 04159000 * ERRNUM set appropriately 04160000 GENCMD ENTER @SC86155 04161000 LA 8,1 One operand @SC86295 04162000 LTR 1,1 @SC86295 04163000 BZ REMCMD Parse REMOTE command @SC86295 04164000 LA 0,AG Packet type = generic command @SC86155 04165000 GENNUL SR 5,5 NO ARGUMENTS @SC86316 04166000 GENFILL STC 0,STYPE Set packet type @SC86155 04167000 L 3,RBUF Put string here @SC86155 04168000 CLI STYPE,AG Generic? @SC86155 04169000 BNE GENOTH1 No subcommand @SC86155 04170000 STC 1,0(3) Save subcommand byte @SC86155 04171000 LA 3,1(3) Move to next character position @SC86155 04172000 B GENOTH1 @SC86295 04173000 GENNXT NTOKN N=RTRN1 Get next argument @SC86295 04174000 LA 5,1(7) Length @SC86295 04175000 LR 4,6 Address @SC86295 04176000 GENOTH1 LTR 1,5 Any argument? @SC86155 04177000 BZ GENFILZ No, done @SC86155 04178000 CLI STYPE,AG Generic? @SC86155 04179000 BNE GENOTH2 No, skip length indicator @SC86155 04180000 TOCHR 1,,0(3) Yes, do it @SC86155 04181000 LA 3,1(3) @SC86155 04182000 GENOTH2 MVC 0(96,3),0(4) Copy argument @SC86155 04183000 TR 0(96,3),ETOA in ASCII @SC86155 04184000 AR 3,5 Advance ptr @SC86155 04185000 BCT 8,GENNXT @SC86295 04186000 GENFILZ S 3,RBUF Length of buffer @SC86155 04187000 ST 3,RBUFL Set buffer size @SC86155 04188000 BAL 8,IPKSET Set state table, exchange parms @SC86155 04189000 DC AL1(AY),AL3(0) ACK'ed Must be just @SC86155 04190000 DC XL1'FF',AL3(GENRET) Stop these 3 @SC88074 04191000 DC AL1(00),AL3(GENAB3) Error items. @SC88074 04191500 BAL 8,GENSET Set state table @SC86155 04192000 * Server cmd Rpack interpret input table @SC86155 04193000 DC AL1(AY),AL3(0) ACK'ed @SC86155 04194000 DC AL1(AS),AL3(GENRPL) Long reply @SC86155 04195000 DC AL1(AX),AL3(GENRPX) Long reply already INIT @SC88074 04196000 DC AL1(AF),AL3(GENRPX) Long reply already INIT @SC88074 04196300 DC XL1'FF',AL3(GENRET) Stop @SC88074 04196600 DC AL1(00),AL3(GENAB3) Error @SC88074 04196900 GENSET BAL 9,ENCODEN Encode command @SC86295 04197000 BAL 9,INPUTSPK Send, get response @SC86295 04198000 MVI ERRNUM,ERRNOE No errors @SC86155 04199000 ICM 0,15,DATL Any short reply? @SC86155 04200000 BZ GENRET No, done @SC86155 04201000 NI FL1,255-EOF Yes, set flags @SC86155 04202000 XC WBUFL,WBUFL Clear old data @SC86155 04203000 OI LOGFLGS,APPN DISP=MOD @SC86295 04204000 BAL 2,GENRPS Set up file name @SC86295 04205000 OPENF O,FILNAM,LOGFDB,FILPTR,E=GENABR @SC89013 04206000 USING FDBD,1 @SC86295 04207000 L 0,FABLRTR Get effective record length @SC88120 04208000 ST 0,MAXOUT Save for folding (if need be) @SC88120 04209000 ST 0,FSIZE Copy LRECL @SC86295 04210000 MVC FRECF,FDBRCF Copy RECFM @SC86295 04211000 DROP 1 @SC86155 04212000 GENOPN KCALL DECODE,E=GENAB2 Copy message to output @SC86155 04213000 ICM 1,15,WBUFL Check length in buffer @SC88120 04214000 BE GENRPZ @SC86155 04215000 KCALL OUTBUF,E=GENAB2 Yes, copy that as well @SC86155 04216000 GENRPZ CLOSF FILPTR @SC86295 04217000 MVI ERRNUM,ERRNOE No errors @SC86155 04218000 B GENFIN @SC86295 04219000 * 04220000 GENRPX CLI BCTR,1 This works only with 1-byte check @SC88074 04221000 BNE GENAB3 @SC88074 04221300 GENRPL DS 0H Long reply @SC88074 04221600 BAL 2,GENRPS Set up file name @SC86295 04222000 KCALL RECEIV @SC86155 04223000 B GENFIN @SC86155 04225000 * 04226000 GENRPS LA 0,L'REPNAM Name string length @SC86295 04227000 LA 1,REPNAM and address @SC86295 04228000 STM 0,1,SCANPTR @SC86295 04229000 LA 0,FFRCF @SC86295 04230000 KCALL FSPEC,FILNAM Convert to filespec @SC86295 04231000 IC 9,FL3 Save flags @SC86295 04232000 OI FL3,APPN Don't erase it @SC86295 04233000 BR 2 @SC86295 04234000 * 04235000 GENAB2 CLOSF FILPTR @SC86295 04236000 B GENABR @SC88074 04236300 GENAB3 IC 9,FL3 Save flags @SC88074 04236600 GENABR KCALL ERPACK @SC86155 04237000 GENFIN STC 9,FL3 Restore flags @SC86295 04238000 GENRET KCALL INTINI,0 @SC86155 04239000 B RTRN0 @SC86295 04240000 * 04241000 * Make foreign Kermit execute command 04242000 REMCMD NTOKN N=RTRN2 @SC86295 04243000 SCAN REMCMDKW,RTRN1 @SC86295 04244000 B RTRN2 @SC86295 04245000 * 04246000 REMCMDKW KW 'COPY',REMCOP,MIN=2 @SC86295 04247000 KW 'CWD',REMARG,MIN=3 @SC86295 04248000 KW 'DIRECTORY',REMARG,MIN=3 @SC86155 04249000 KW 'ERASE',REMARG @SC86155 04250000 KW 'HELP',REMARG @SC86155 04251000 KW 'HOST',REMHST,MIN=2 @SC86155 04252000 KW 'KERMIT',REMKRM @SC86155 04253000 KW 'RENAME',REMREN @SC86295 04254000 KW 'SPACE',REMSPA,MIN=2 @SC86155 04255000 KW 'TYPE',REMARG,MIN=2 @SC86155 04256000 KW , @SC86155 04257000 * 04258000 REMHST LA 0,AC Host command @SC86155 04259000 B REMPRS @SC86155 04260000 * 04261000 REMKRM LA 0,AK KERMIT command @SC86155 04262000 REMPRS FTOKN N=RTRN1 See if anything given @SC86295 04263000 LR 4,7 @SC86295 04264000 LR 5,6 Use whole string @SC86295 04265000 B GENFILL @SC86295 04266000 * 04267000 REMSPA LA 1,AU Space command @SC86155 04268000 B REMPRSG @SC86155 04269000 * 04270000 REMCOP LA 8,2 Copy: two files @SC86295 04271000 LA 1,AK @SC86295 04272000 B REMPRSG @SC86295 04273000 REMREN LA 8,2 Rename: two files @SC86295 04274000 * 04275000 REMARG SR 1,1 @SC86155 04276000 IC 1,0(6) 1st letter is abbrev @SC86155 04277000 IC 1,ETOAD(1) ASCII @SC88273 04278000 REMPRSG LA 0,AG (generic) @SC86155 04279000 NTOKN N=GENNUL Skip any blanks @SC86295 04280000 LA 5,1(7) Save length @SC86295 04281000 LR 4,6 Save ptr @SC86295 04282000 B GENFILL Copy to output @SC86155 04283000 LOCALS , @SC86295 04284000 REMCMD EXIT , @SC86155 04285000 TITLE 'TBLSET Routine - set up character set' @SC90040 04286000 * Define new translation tables 04287000 * Entry: Names of table in TRNALF and FILALF, R1->tables 04288000 * R0->item just changed, if any (else, 0) 04289000 * Tables should be a pair with ATOE first 04290000 * Exit: R15=0 if ok, R15=1 if error ERRNUM unchanged. 04291000 TBLSET ENTER , @SC90040 04292000 LR 9,1 Save ptr to pair of tables @SC90040 04293000 LA 1,ATOE Usual table to fill @SC90040 04294000 CR 1,9 @SC90040 04295000 BNE *+8 Special case, don't enable attr. @SC90040 04296000 OI ATFL2,ATFENC Now allow Encoding attribute @SC90040 04297000 LA 5,TRNTBL Ptr to list @SC90040 04298000 LA 6,LTRNTBL @SC90040 04299000 LA 7,TRNTBLZ Ptr to end of list @SC90040 04300000 LA 1,TRNALF Ptr to transfer set name @SC90040 04301000 TBLLKP CLC 0(16,5),0(1) Compare both names @SC90040 04302000 BE TBLFND Got it! @SC90040 04303000 BXLE 5,6,TBLLKP @SC90040 04304000 LTR 0,0 Which char set just changed? @SC90040 04305000 BNZ TBLFIX Patch other to make valid combo @SC90040 04306000 TBLNFND WTEXT 'Undefined character translation' @SC90040 04307000 B RTRN1 @SC90040 04308000 * 04309000 TBLREP MVC TRNALF(16),0(5) Set up new table name @SC90040 04310000 * Enter here with R9->tables, R5->needed translation entry @SC90040 04311000 TBLFND LR 1,9 Fill in ATOE table first @SC90040 04312000 LM 6,7,16(5) @SC90040 04313000 BAL 2,TBLCPY @SC90040 04314000 LA 1,256(,9) Fill in ETOA table second @SC90040 04315000 LM 6,8,24(5) @SC90040 04316000 ST 8,CDESPTR Save character set designator @SC90040 04317000 BAL 2,TBLCPY @SC90040 04318000 B RTRN0 @SC90040 04319000 * 04320000 TBLFIX LA 5,TRNTBL Ptr to list again @SC90040 04321000 CR 0,1 Giving precedence to transfer set?@SC90040 04322000 BNE TBLLKF No, insist on file set @SC90040 04323000 TBLLKT CLC 0(8,5),0(1) Compare just transfer set @SC90040 04324000 BE TBLREP First such entry selects file set @SC90040 04325000 BXLE 5,6,TBLLKT @SC90040 04326000 TBLLKF CLC 8(8,5),8(1) Compare just file set @SC90040 04327000 BNE TBLLKFZ Keep looking @SC90040 04328000 ICM 0,15,LTRNTBL-4(5) Any preferred transfer set? @SC90040 04329000 BM TBLREP Yes, this very one @SC90040 04330000 TBLLKFZ BXLE 5,6,TBLLKF @SC90040 04331000 B TBLNFND Something bizarre happened @SC90040 04332000 * 04333000 * Entry: R6->Designator string, R7=length @SC90040 04334000 * Exit: Correct table set up and R15=0 if ok, else 1 @SC90040 04335000 TBLATT ENTER ALT @SC90040 04336000 LA 1,TBLDS Start of designator list @SC90040 04337000 SR 3,3 @SC90040 04338000 TBLALP ICM 3,1,4(1) Get length of next item in list @SC90040 04339000 BZ RTRN1 End. String not found @SC90040 04340000 CR 3,7 Right length? @SC90040 04341000 BNE TBLALQ No, keep looking @SC90040 04342000 LR 4,3 Get length for EX @SC90040 04343000 BCTR 4,0 @SC90040 04344000 EX 4,TBLACLC Strings match? @SC90040 04345000 BNE TBLALQ No, keep looking @SC90040 04346000 ICM 5,15,0(1) Yes, get table pointer @SC90040 04347000 LR 6,5 Set to scan through tables @SC90040 04348000 TBLAFLP CLC 0(8,6),0(5) See if still same transfer set @SC90040 04349000 BNE TBLAFND No, use default ??? @SC90040 04350000 CLC FILALF,8(6) See if found right local set @SC90040 04351000 BE TBLAFNO Yes, use this table @SC90040 04352000 LA 6,LTRNTBL(,6) No, try next @SC90040 04353000 B TBLAFLP @SC90040 04354000 TBLAFNO LR 5,6 @SC90040 04355000 TBLAFND CLC TRNALF(16),0(5) Already have this table? @SC90040 04356000 BE RTRN0 Yes, all done @SC90040 04357000 MVC TRNALF(16),0(5) Set up new table name @SC90040 04358000 LA 9,ATOE Set ptr to working tables @SC90040 04359000 B TBLFND Adopt table @SC90040 04360000 TBLALQ LA 1,5(3,1) @SC90040 04361000 B TBLALP @SC90040 04362000 TBLACLC CLC 0(,6),5(1) Compare against list item @SC90040 04363000 * 04364000 * Copy info into table: basic stuff + any "corrections" @SC90040 04365000 * R1->table, R6->basic stuff, R7->corrections, if any @SC90040 04366000 TBLCPY LTR 6,6 @SC90040 04367000 BZ TBLCPI No EtoA table - just invert AtoE @SC90040 04368000 MVC 0(256,1),0(6) Basic pattern @SC90040 04369000 LTR 7,7 Ptr to modification list @SC90040 04370000 BZR 2 No list @SC90040 04371000 SR 6,6 @SC90040 04372000 TBLCPL ICM 6,1,0(7) Get offset into table @SC90040 04373000 BZR 2 End of list @SC90040 04374000 IC 0,1(,7) Get changed value @SC90040 04375000 STC 0,0(6,1) @SC90040 04376000 LA 7,2(,7) @SC90040 04377000 B TBLCPL @SC90040 04378000 TBLCPI SR 7,7 Clear work regs. @SC90040 04379000 XC 0(256,1),0(1) Clear out table @SC90040 04380000 LA 7,255 @SC90040 04381000 TBLCPIL IC 6,ATOE(7) Get EBCDIC for (7) @SC90040 04382000 STC 7,0(6,1) And store inverse @SC90040 04383000 BCT 7,TBLCPIL Do all but NULL @SC90040 04384000 MVI 0(1),0 NULL is always NULL @SC90040 04385000 BR 2 @SC90040 04386000 * 04387000 * Format is: CL8'transfer',CL8'local' @SC90040 04388000 * A(t-to-l,adjusts,l-to-t,adjusts,designator,flag) @SC90040 04389000 * if any or 0 if any @SC90040 04390000 * Items should be grouped by transfer set, default 1st @SC90040 04391000 * Flag is -1 in exactly one entry for each possible file set, @SC90040 04392000 * but flag is 0 for any others. "-1" marks preferred entry. @SC90040 04393000 TRNTBL DS 0F Table of translations @SC90040 04394000 DC C'ASCII EBCDIC ' *** Default *** @SC90040 04395000 DC A(ATOED,0,ETOAD,0,0,0) @SC90040 04396000 DC C'ASCII CP037 ' @SC90040 04397000 DC A(ATOED,ASE37F,ETOAD,0,0,0) @SC90040 04398000 DC C'ASCII CP500 ' @SC90040 04399000 DC A(ATOED,ASE5F,ETOAD,0,0,0) @SC90040 04400000 DC C'ASCII DKOI ' @SC90040 04401000 DC A(CYTODKOI,ASDKF,DKOITOAS,0,0,0) @SC90040 04402000 TRNTNCY DC C'CYRILLICDKOI ' USSR @SC90040 04403000 DC A(CYTODKOI,0,0,0,TBLDSCY,-1) @SC90040 04404000 TRNTNL1 DC C'LATIN1 EBCDIC ' Default Latin-1 table @SC90040 04405000 DC A(L1TOE,0,0,0,TBLDSL1,-1) @SC90040 04406000 TRNTNCA DC C'LATIN1 CP037 ' US, Fr. Canada, Neth, Port. @SC90040 04407000 DC A(L1TOE,L1E37F,0,0,TBLDSL1,-1) @SC90040 04408000 TRNTNDE DC C'LATIN1 CP273 ' Germany @SC90040 04409000 DC A(L1TOE,L1E273F,0,0,TBLDSL1,-1) @SC90040 04410000 TRNTNBR DC C'LATIN1 CP275 ' Brazil @SC90040 04411000 DC A(L1TOE,L1E275F,0,0,TBLDSL1,-1) @SC90040 04412000 TRNTNDK DC C'LATIN1 CP277 ' Denmark, Norway @SC90040 04413000 DC A(L1TOE,L1E277F,0,0,TBLDSL1,-1) @SC90040 04414000 TRNTNSE DC C'LATIN1 CP278 ' Finland, Sweden @SC90040 04415000 DC A(L1TOE,L1E278F,0,0,TBLDSL1,-1) @SC90040 04416000 TRNTNIT DC C'LATIN1 CP280 ' Italy @SC90040 04417000 DC A(L1TOE,L1E280F,0,0,TBLDSL1,-1) @SC90040 04418000 TRNTNPT DC C'LATIN1 CP282 ' Portugal @SC90040 04419000 DC A(L1TOE,L1E282F,0,0,TBLDSL1,-1) @SC90040 04420000 TRNTNES DC C'LATIN1 CP284 ' Spain @SC90040 04421000 DC A(L1TOE,L1E284F,0,0,TBLDSL1,-1) @SC90040 04422000 TRNTNUK DC C'LATIN1 CP285 ' UK @SC90040 04423000 DC A(L1TOE,L1E285F,0,0,TBLDSL1,-1) @SC90040 04424000 TRNTNFR DC C'LATIN1 CP297 ' France @SC90040 04425000 DC A(L1TOE,L1E297F,0,0,TBLDSL1,-1) @SC90040 04426000 TRNTNBE DC C'LATIN1 CP500 ' Belgium, Switzerland @SC90040 04427000 DC A(L1TOE,L1E5F,0,0,TBLDSL1,-1) @SC90040 04428000 TRNTNIS DC C'LATIN1 CP871 ' Iceland @SC90040 04429000 DC A(L1TOE,L1E871F,0,0,TBLDSL1,-1) @SC90040 04430000 TRNTNGR DC C'GREEK CP875 ' Greece @SC90040 04431000 DC A(GRTOE875,0,0,0,TBLDSGR,-1) @SC90040 04432000 TRNTNIL DC C'HEBREW CP424 ' Israel @SC90040 04433000 DC A(L8TOE424,0,0,0,TBLDSHE,-1) @SC90040 04434000 TRNTBLZ EQU * @SC90040 04435000 TRNTNJP DC C'KATAKANACP290 ' Japan @SC90040 04436000 DC A(KATOE290,0,E290TOKA,0,TBLDSKA,-1) @SC90040 04437000 LTRNTBL EQU *-TRNTBLZ Item length @SC90040 04438000 * 04439000 * List of transfer character set designators @SC90040 04440000 TBLDS EQU * @SC90040 04441000 TBLDSCY DC AL4(TRNTNCY),AL1(6,AI,A6,ASL,A1,A4,A4) I6/144 @SC90040 04442000 TBLDSGR DC AL4(TRNTNGR),AL1(6,AI,A6,ASL,A1,A2,A6) I6/126 @SC90040 04443000 TBLDSHE DC AL4(TRNTNIL),AL1(6,AI,A6,ASL,A1,A3,A8) I6/138 @SC90040 04444000 TBLDSKA DC AL4(TRNTNJP),AL1(6,AI,A1,A4,ASL,A1,A3) I14/13 @SC90040 04445000 TBLDSL1 DC AL4(TRNTNL1),AL1(6,AI,A6,ASL,A1,A0,A0) I6/100 @SC90040 04446000 DC AL4(TRNTNL1),AL1(6,AI,A2,ASL,A1,A0,A0) **TEMP** @SC90040 04447000 DC XL5'0' End of table @SC90040 04448000 LOCALS , @SC90040 04449000 TBLSET EXIT , @SC90040 04450000 TRNTBLD CSECT @SC90040 04451000 * 04452000 * Corrections: ASCII -> DKOI @SC90040 04453000 * ref: Konstantin Vinogradov (ICSTI) @SC90040 04454000 ASDKF DC X'60B8',X'61CC',X'62CD',X'63BB',X'64BC',X'65BD' @SC90040 04455000 DC X'66BE',X'67BF',X'68CA',X'69CB',X'6ACC',X'6BCD' @SC90040 04456000 DC X'6CCE',X'6DCF',X'6EDA',X'6FDB',X'70DC',X'71DD' @SC90040 04457000 DC X'72DE',X'73DF',X'74EA',X'75EB',X'76EC',X'77ED' @SC90040 04458000 DC X'78EE',X'79EF',X'7AFA',X'7BFB',X'7CFC',X'7DFD' @SC90040 04459000 DC X'7EFE',X'2775',X'0' @SC90040 04460000 * 04461000 * Corrections: LATIN1 -> CP 037 @SC90040 04462000 * ref: Andre Pirard (U Liege) @SC90040 04463000 L1E37F DC X'AC5F',X'DDAD',X'A8BD' @SC90040 04464000 ASE37F DC X'5BBA',X'5DBB',X'5EB0',X'0' @SC90040 04465000 * 04466000 * Corrections: LATIN1 -> CP 273 @SC90040 04467000 * ref: Andre Pirard (U Liege) @SC90040 04468000 L1E273F DC X'214F',X'40B5',X'5B63',X'5CEC',X'5DFC',X'7B43' @SC90040 04469000 DC X'7CBB',X'7DDC',X'7E59',X'A2B0',X'A6CC',X'A77C' @SC90040 04470000 DC X'A8BD',X'ACBA',X'C44A',X'D6E0',X'DC5A',X'DDAD' @SC90040 04471000 DC X'DFA1',X'E4C0',X'F66A',X'FCD0',X'0' @SC90040 04472000 * 04473000 * Corrections: LATIN1 -> CP 275 @SC90040 04474000 * ref: About Type (IBM S544-3516-02) @SC90040 04475000 L1E275F DC X'214F',X'23EF',X'245A',X'4066',X'5B71',X'5D68' @SC90040 04476000 DC X'6046',X'7BCF',X'7CBB',X'7D51',X'A2B0',X'A648' @SC90040 04477000 DC X'A8BD',X'ACBA',X'C37B',X'C75B',X'C94A',X'D57C' @SC90040 04478000 DC X'DDAD',X'E379',X'E76A',X'E9D0',X'F5C0',X'0' @SC90040 04479000 * 04480000 * Corrections: LATIN1 -> CP 277 @SC90040 04481000 * ref: Andre Pirard (U Liege) @SC90040 04482000 L1E277F DC X'214F',X'234A',X'2467',X'4080',X'5B9E',X'5D9F' @SC90040 04483000 DC X'7B9C',X'7CBB',X'7D47',X'7EDC',X'A2B0',X'A45A' @SC90040 04484000 DC X'A670',X'A8BD',X'ACBA',X'C55B',X'C67B',X'D87C' @SC90040 04485000 DC X'DDAD',X'E5D0',X'E6C0',X'F86A',X'FCA1',X'0' @SC90040 04486000 * 04487000 * Corrections: LATIN1 -> CP 278 @SC90040 04488000 * ref: Andre Pirard (U Liege) @SC90040 04489000 L1E278F DC X'214F',X'2363',X'2467',X'40EC',X'5BB5',X'5C71' @SC90040 04490000 DC X'5D9F',X'6051',X'7B43',X'7CBB',X'7D47',X'7EDC' @SC90040 04491000 DC X'A2B0',X'A45A',X'A6CC',X'A74A',X'A8BD',X'ACBA' @SC90040 04492000 DC X'C47B',X'C55B',X'C9E0',X'D67C',X'DDAD',X'E4C0' @SC90040 04493000 DC X'E5D0',X'E979',X'F66A',X'FCA1',X'0' @SC90040 04494000 * 04495000 * Corrections: LATIN1 -> CP 280 @SC90040 04496000 * ref: Andre Pirard (U Liege) @SC90040 04497000 L1E280F DC X'214F',X'23B1',X'40B5',X'5B90',X'5C48',X'5D51' @SC90040 04498000 DC X'60DD',X'7B44',X'7CBB',X'7D54',X'7E58',X'A2B0' @SC90040 04499000 DC X'A37B',X'A6CD',X'A77C',X'A8BD',X'ACBA',X'B04A' @SC90040 04500000 DC X'DDAD',X'E0C0',X'E7E0',X'E8D0',X'E95A',X'ECA1' @SC90040 04501000 DC X'F26A',X'F979',X'0' @SC90040 04502000 * 04503000 * Corrections: LATIN1 -> CP 282 @SC90040 04504000 * ref: About Type (IBM S544-3516-02) @SC90040 04505000 L1E282F DC X'214F',X'2366',X'40EF',X'5B4A',X'5C68',X'5D5A' @SC90040 04506000 DC X'7B46',X'7CBB',X'7DBE',X'7E48',X'A2B0',X'A6CF' @SC90040 04507000 DC X'A8BD',X'ACBA',X'B4D0',X'C37B',X'C7E0',X'D57C' @SC90040 04508000 DC X'DDAD',X'E3C0',X'E7A1',X'F56A',X'0' @SC90040 04509000 * 04510000 * Corrections: LATIN1 -> CP 284 @SC90040 04511000 * ref: Andre Pirard (U Liege) @SC90040 04512000 L1E284F DC X'21BB',X'2369',X'5B4A',X'5D5A',X'5EBA',X'7EBD' @SC90040 04513000 DC X'A2B0',X'A649',X'A8A1',X'AC5F',X'D17B',X'DDAD' @SC90040 04514000 DC X'F16A',X'0' @SC90040 04515000 * 04516000 * Corrections: LATIN1 -> CP 285 @SC90040 04517000 * ref: Andre Pirard (U Liege) @SC90040 04518000 L1E285F DC X'244A',X'5BB1',X'5DBB',X'5EBA',X'7EBC',X'A2B0' @SC90040 04519000 DC X'A35B',X'A8BD',X'AC5F',X'AFA1',X'DDAD',X'0' @SC90040 04520000 * 04521000 * Corrections: LATIN1 -> CP 297 @SC90040 04522000 * ref: Andre Pirard (U Liege) @SC90040 04523000 L1E297F DC X'214F',X'23B1',X'4044',X'5B90',X'5C48',X'5DB5' @SC90040 04524000 DC X'60A0',X'7B51',X'7CBB',X'7D54',X'7EBD',X'A2B0' @SC90040 04525000 DC X'A37B',X'A6DD',X'A75A',X'A8A1',X'ACBA',X'B04A' @SC90040 04526000 DC X'B579',X'DDAD',X'E07C',X'E7E0',X'E8D0',X'E9C0' @SC90040 04527000 DC X'F96A',X'0' @SC90040 04528000 * 04529000 * Corrections: LATIN1 -> CP 500 @SC90040 04530000 * ref: Andre Pirard (U Liege) @SC90040 04531000 L1E5F DC X'A2B0',X'A8BD',X'ACBA',X'DDAD' @SC90040 04532000 ASE5F DC X'214F',X'5B4A',X'5D5A',X'7CBB',X'0' @SC90040 04533000 * 04534000 * Corrections: LATIN1 -> CP 871 @SC90040 04535000 * ref: About Type (IBM S544-3516-02) @SC90040 04536000 L1E871F DC X'214F',X'40AC',X'5BAE',X'5CBE',X'5D9E',X'5EEC' @SC90040 04537000 DC X'608C',X'7B8E',X'7CBB',X'7D9C',X'7ECC',X'A2B0' @SC90040 04538000 DC X'A8BD',X'ACBA',X'B4E0',X'C65A',X'D07C',X'D65F' @SC90040 04539000 DC X'DDAD',X'DE4A',X'E6D0',X'F079',X'F6A1',X'FEC0' @SC90040 04540000 DC X'0' @SC90040 04541000 * 04542000 L1TOE EQU * LATIN1 to EBCDIC @SC90040 04543000 * ref: composite @SC90040 04544000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04545000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04546000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04547000 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04548000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04549000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04550000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C90040 04551000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04552000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04553000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04554000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04555000 HTBL 41,AA,4A,B1,9F,B2,6A,B5,BB,B4,9A,8A,B0,CA,AF,BC A C90040 04556000 HTBL 90,8F,EA,FA,BE,A0,B6,B3,9D,DA,9B,8B,B7,B8,B9,AB B C90040 04557000 HTBL 64,65,62,66,63,67,9E,68,74,71,72,73,78,75,76,77 C C90040 04558000 HTBL AC,69,ED,EE,EB,EF,EC,BF,80,FD,FE,FB,FC,BA,AE,59 D C90040 04559000 HTBL 44,45,42,46,43,47,9C,48,54,51,52,53,58,55,56,57 E C90040 04560000 HTBL 8C,49,CD,CE,CB,CF,CC,E1,70,DD,DE,DB,DC,8D,8E,DF F C90040 04561000 * 04562000 DKOITOAS EQU * DKOI (EBCDIC) to ASCII @SC90040 04563000 * ref: Konstantin Vinogradov (ICSTI) @SC90040 04564000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04565000 HTBL 00,01,02,03,00,09,00,7F,00,00,00,0B,0C,0D,0E,0F 0 C90040 04566000 HTBL 10,11,12,13,00,00,08,00,18,19,00,00,1C,1D,1E,1F 1 C90040 04567000 HTBL 00,00,00,00,00,0A,17,1B,00,00,00,00,00,05,06,07 2 C90040 04568000 HTBL 00,00,16,00,00,00,00,04,00,00,00,00,14,15,00,1A 3 C90040 04569000 HTBL 20,00,00,00,00,00,00,00,00,00,5B,2E,3C,28,2B,21 4 C90040 04570000 HTBL 26,00,00,00,00,00,00,00,00,00,5D,24,2A,29,3B,5E 5 C90040 04571000 HTBL 2D,2F,00,00,00,00,00,00,00,00,7C,2C,25,5F,3E,3F 6 C90040 04572000 HTBL 00,00,00,00,00,27,60,61,62,60,3A,23,40,27,3D,22 7 C90040 04573000 HTBL 63,41,42,43,44,45,46,47,48,49,64,65,66,67,68,69 8 C90040 04574000 HTBL 6A,4A,4B,4C,4D,4E,4F,50,51,52,6B,6C,6D,6E,6F,70 9 C90040 04575000 HTBL 71,7E,53,54,55,56,57,58,59,5A,72,73,74,75,76,77 A C90040 04576000 HTBL 78,79,7A,7B,7C,7D,7E,27,60,61,62,63,64,65,66,67 B C90040 04577000 HTBL 7B,41,42,43,44,45,46,47,48,49,68,69,6A,6B,6C,6D C C90040 04578000 HTBL 7D,4A,4B,4C,4D,4E,4F,50,51,52,6E,6F,70,71,72,73 D C90040 04579000 HTBL 5C,00,53,54,55,56,57,58,59,5A,74,75,76,77,78,79 E C90040 04580000 HTBL 30,31,32,33,34,35,36,37,38,39,7A,7B,7C,7D,7E,00 F C90040 04581000 * 04582000 CYTODKOI EQU * CYRILLIC to DKOI (EBCDIC) @SC90040 04583000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04584000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04585000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04586000 HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04587000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04588000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04589000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04590000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04591000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04592000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04593000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90040 04594000 HTBL 41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90040 04595000 HTBL B9,BA,ED,BF,BC,BD,EC,FA,CB,CC,CD,CE,CF,DA,DB,DC B C90040 04596000 HTBL DE,DF,EA,EB,BE,CA,BB,FE,FB,FD,75,EF,EE,FC,B8,DD C C90040 04597000 HTBL 77,78,AF,8D,8A,8B,AE,B2,8F,90,9A,9B,9C,9D,9E,9F D C90040 04598000 HTBL AA,AB,AC,AD,8C,8E,80,B6,B3,B5,B7,B1,B0,B4,76,A0 E C90040 04599000 HTBL 58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,FF F C90040 04600000 * 04601000 GRTOE875 EQU * Latin/Greek to Greece EBCDIC @SC90040 04602000 * ref: Michel Suignard @SC90040 04603000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04604000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04605000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04606000 HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04607000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04608000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04609000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04610000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04611000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04612000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04613000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04614000 HTBL 74,CE,DE,B0,DC,E1,DF,EB,70,FB,EC,EE,EF,CA,ED,CF A C90040 04615000 HTBL 90,DA,EA,FA,A0,80,71,DD,72,73,75,FE,76,DB,77,78 B C90040 04616000 HTBL CC,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 C C90040 04617000 HTBL 57,58,FC,59,62,63,64,65,66,67,68,69,B1,B2,B3,B5 D C90040 04618000 HTBL CD,8A,8B,8C,8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC E C90040 04619000 HTBL AD,AE,BA,AF,BB,BC,BD,BE,BF,CB,B4,B8,B6,B7,B9,FD F C90040 04620000 * 04621000 L8TOE424 EQU * Latin/Hebrew to Israel EBCDIC @SC90040 04622000 * ref: Jonathan Rosenne (IBM Israel) @SC90040 04623000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04624000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04625000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04626000 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04627000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04628000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04629000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,BA,E0,BB,B0,6D 5 C90040 04630000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04631000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04632000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04633000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04634000 HTBL 74,AA,4A,B1,9F,B2,6A,B5,BD,B4,BF,8A,5F,CA,AF,BC A C90040 04635000 HTBL 90,8F,EA,FA,BE,A0,B6,B3,9D,DA,E1,8B,B7,B8,B9,AB B C90040 04636000 HTBL CB,CC,CD,9C,CE,CF,9E,9B,DD,DE,72,73,70,75,76,77 C C90040 04637000 HTBL AC,8C,ED,EE,EB,EF,EC,9A,80,FD,FE,FB,FC,AD,AE,78 D C90040 04638000 HTBL 41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 E C90040 04639000 HTBL 58,59,62,63,64,65,66,67,68,69,71,DB,DC,8D,8E,DF F C90040 04640000 * 04641000 KATOE290 EQU * KATAKANA to Japanese EBCDIC (290) @SC90040 04642000 * ref: composite @SC90040 04643000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04644000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04645000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04646000 HTBL 40,5A,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04647000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04648000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04649000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,00,5B,00,5F,6D 5 C90040 04650000 HTBL 00,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 6 C90040 04651000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,C0,4F,D0,A1,07 7 C90040 04652000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04653000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04654000 HTBL 40,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C90040 04655000 HTBL 58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C90040 04656000 HTBL 91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C90040 04657000 HTBL A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C90040 04658000 HTBL 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,57 E C90040 04659000 HTBL 00,00,CD,CE,CB,CF,CC,E1,70,DD,DE,DB,DC,00,00,DF F C90040 04660000 * 04661000 E290TOKA EQU * Japanese EBCDIC (290) to KATAKANA @SC90040 04662000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04663000 HTBL 00,01,02,03,9C,09,86,7F,97,8D,8E,0B,0C,0D,0E,0F 0 C90040 04664000 HTBL 10,11,12,13,9D,85,08,87,18,19,92,8F,1C,1D,1E,1F 1 C90040 04665000 HTBL 80,81,82,83,84,0A,17,1B,88,89,8A,8B,8C,05,06,07 2 C90040 04666000 HTBL 90,91,16,93,94,95,96,04,98,99,9A,9B,14,15,9E,1A 3 C90040 04667000 HTBL 20,A1,A2,A3,A4,A5,A6,A7,A8,A9,00,2E,3C,28,2B,7C 4 C90040 04668000 HTBL 26,AA,AB,AC,AD,AE,AF,EF,B0,00,21,5C,2A,29,3B,5E 5 C90040 04669000 HTBL 2D,2F,00,00,00,00,00,00,00,00,00,2C,25,5F,3E,3F 6 C90040 04670000 HTBL F8,00,00,00,00,00,00,00,00,00,3A,23,40,27,3D,22 7 C90040 04671000 HTBL 00,B1,B2,B3,B4,B5,B6,B7,B8,B9,BA,00,BB,BC,BD,BE 8 C90040 04672000 HTBL BF,C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,00,00,CA,CB,CC 9 C90040 04673000 HTBL 00,7E,CD,CE,CF,D0,D1,D2,D3,D4,D5,00,D6,D7,D8,D9 A C90040 04674000 HTBL 00,00,00,00,00,00,00,00,00,00,DA,DB,DC,DD,DE,DF B C90040 04675000 HTBL 7B,41,42,43,44,45,46,47,48,49,00,F4,F6,F2,F3,F5 C C90040 04676000 HTBL 7D,4A,4B,4C,4D,4E,4F,50,51,52,00,FB,FC,F9,FA,FF D C90040 04677000 HTBL 24,F7,53,54,55,56,57,58,59,5A,00,00,00,00,00,00 E C90040 04678000 HTBL 30,31,32,33,34,35,36,37,38,39,00,00,00,00,00,9F F C90040 04679000 * 04680000